From 81dbc07d58f72be2976495d8df97fed5abee2a8a Mon Sep 17 00:00:00 2001 From: yamaoka Date: Sun, 14 Nov 2004 22:11:57 +0000 Subject: [PATCH] Synch to No Gnus 200411142100. --- lisp/ChangeLog | 33 +++++++++++++ lisp/gnus-art.el | 2 +- lisp/gnus-start.el | 7 ++- lisp/hashcash.el | 133 ++++++++++++++++++++++++++++++++++++++++++++++++---- lisp/message.el | 10 ++-- texi/ChangeLog | 5 ++ texi/gnus-ja.texi | 3 +- texi/gnus.texi | 4 +- 8 files changed, 175 insertions(+), 22 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7b4c96f..c6f46c0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,36 @@ +2004-11-14 Reiner Steib + + * gnus-start.el (gnus-convert-old-newsrc): Assign + legacy-gnus-agent to 5.10.7. + +2004-11-14 Lars Magne Ingebrigtsen + + * gnus-art.el (article-unsplit-urls): Don't anchor urls to the + start of the lines. + +2004-11-14 Magnus Henoch + + * hashcash.el (hashcash-default-payment): Change default to 20 + (hashcash-default-accept-payment): Change default to 20 + (hashcash-process-alist): New variable + (hashcash-generate-payment-async): Add + (hashcash-already-paid-p): Add + (hashcash-insert-payment): Don't generate payments twice + (hashcash-insert-payment-async): Add + (hashcash-insert-payment-async-2): Add + (hashcash-cancel-async): Add + (hashcash-wait-async): Add + (hashcash-processes-running-p): Add + (hashcash-wait-or-cancel): Add + (mail-add-payment): New optional argument. Conditionally start + asynchronous calculation. + (mail-add-payment-async): Add + + * message.el (message-send-mail): Wait for asynchronous hashcash + results. Don't clobber existing X-Hashcash headers. + (message-setup-1): Call mail-add-payment-async when + message-generate-hashcash is non-nil. + 2004-11-11 ARISAWA Akihiro (tiny change) * message.el (message-use-alternative-email-as-from): Examine the diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 8ee36a6..0d063c3 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -2572,7 +2572,7 @@ If READ-CHARSET, ask for a coding system." (let ((inhibit-read-only t)) (goto-char (point-min)) (while (re-search-forward - "^\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) + "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t) (replace-match "\\1\\3" t))) (when (interactive-p) (gnus-treat-article nil)))) diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index e217f8c..d52044e 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -2278,13 +2278,13 @@ If FORCE is non-nil, the .newsrc file is read." ;; doesn't change with each release) and the ;; function that must be applied to convert the ;; previous version into the current version. - '(("September Gnus v0.1" nil + '(("September Gnus v0.1" nil gnus-convert-old-ticks) ("Oort Gnus v0.08" "legacy-gnus-agent" gnus-agent-convert-to-compressed-agentview) - ("No Gnus v0.2" "legacy-gnus-agent" + ("Gnus v5.10.7" "legacy-gnus-agent" gnus-agent-unlist-expire-days) - ("No Gnus v0.2" "legacy-gnus-agent" + ("Gnus v5.10.7" "legacy-gnus-agent" gnus-agent-unhook-expire-days))) #'car-less-than-car))) ;; Skip converters older than the file version @@ -2301,7 +2301,6 @@ If FORCE is non-nil, the .newsrc file is read." (when (and load-from (not (fboundp func))) (load load-from t)) - (or prompt-displayed (not (gnus-convert-converter-needs-prompt func)) (while (let (c diff --git a/lisp/hashcash.el b/lisp/hashcash.el index 712eb87..c0a799d 100644 --- a/lisp/hashcash.el +++ b/lisp/hashcash.el @@ -30,15 +30,29 @@ ;; Call mail-add-payment to add a hashcash payment to a mail message ;; in the current buffer. ;; -;; To automatically add payments to all outgoing mail: +;; Call mail-add-payment-async after writing the addresses but before +;; writing the mail to start calculating the hashcash payment +;; asynchronously. +;; +;; The easiest way to do this automatically for all outgoing mail +;; is to set `message-generate-hashcash' to t. If you want more +;; control, try the following hooks. +;; +;; To automatically add payments to all outgoing mail when sending: ;; (add-hook 'message-send-hook 'mail-add-payment) +;; +;; To start calculations automatically when addresses are prefilled: +;; (add-hook 'message-setup-hook 'mail-add-payment-async) +;; +;; To check whether calculations are done before sending: +;; (add-hook 'message-send-hook 'hashcash-wait-or-cancel) ;;; Code: (eval-and-compile (autoload 'executable-find "executable")) -(defcustom hashcash-default-payment 10 +(defcustom hashcash-default-payment 20 "*The default number of bits to pay to unknown users. If this is zero, no payment header will be generated. See `hashcash-payment-alist'." @@ -51,7 +65,7 @@ ADDR is the email address of the intended recipient and AMOUNT is the value of hashcash payment to be made to that user. STRING, if present, is the string to be hashed; if not present ADDR will be used.") -(defcustom hashcash-default-accept-payment 10 +(defcustom hashcash-default-accept-payment 20 "*The default minimum number of bits to accept on incoming payments." :type 'integer) @@ -71,6 +85,9 @@ is used instead.") "*Specifies whether or not hashcash payments should be made to newsgroups." :type 'boolean) +(defvar hashcash-process-alist nil + "Alist of asynchronous hashcash processes and buffers.") + (require 'mail-utils) (eval-and-compile @@ -122,6 +139,19 @@ is used instead.") (hashcash-token-substring)) (error "No `hashcash' binary found"))) +(defun hashcash-generate-payment-async (str val callback) + "Generate a hashcash payment by finding a VAL-bit collison on STR. +Return immediately. Call CALLBACK with process and result when ready." + (if (> val 0) + (let ((process (start-process "hashcash" nil + hashcash-path "-m" "-q" "-b" (number-to-string val) str))) + (setq hashcash-process-alist (cons + (cons process (current-buffer)) + hashcash-process-alist)) + (set-process-filter process `(lambda (process output) + (funcall ,callback process output)))) + (funcall callback nil))) + (defun hashcash-check-payment (token str val) "Check the validity of a hashcash payment." (if hashcash-path @@ -151,17 +181,87 @@ is used instead.") ((equal (aref token 6) ?:) 1.1) (t (error "Unknown hashcash format version")))) +(defun hashcash-already-paid-p (recipient) + "Check for hashcash token to RECIPIENT in current buffer." + (save-excursion + (save-restriction + (message-narrow-to-headers-or-head) + (let ((token (message-fetch-field "x-hashcash"))) + (and (stringp token) + (string-match (regexp-quote recipient) token)))))) + ;;;###autoload (defun hashcash-insert-payment (arg) "Insert X-Payment and X-Hashcash headers with a payment for ARG" (interactive "sPay to: ") - (let ((pay (hashcash-generate-payment (hashcash-payment-to arg) - (hashcash-payment-required arg)))) - (when pay + (unless (hashcash-already-paid-p arg) + (let ((pay (hashcash-generate-payment (hashcash-payment-to arg) + (hashcash-payment-required arg)))) + (when pay + ;; (insert-before-markers "X-Payment: hashcash " + ;; (number-to-string (hashcash-version pay)) " " + ;; pay "\n") + (insert-before-markers "X-Hashcash: " pay "\n"))))) + +;;;###autoload +(defun hashcash-insert-payment-async (arg) + "Insert X-Payment and X-Hashcash headers with a payment for ARG +Only start calculation. Results are inserted when ready." + (interactive "sPay to: ") + (unless (hashcash-already-paid-p arg) + (hashcash-generate-payment-async (hashcash-payment-to arg) + (hashcash-payment-required arg) + `(lambda (process payment) + (hashcash-insert-payment-async-2 ,(current-buffer) process payment))))) + +(defun hashcash-insert-payment-async-2 (buffer process pay) + (with-current-buffer buffer + (save-excursion + (save-restriction + (setq hashcash-process-alist (delq + (assq process hashcash-process-alist) + hashcash-process-alist)) + (goto-char (point-min)) + (search-forward mail-header-separator) + (beginning-of-line) + (when pay ;; (insert-before-markers "X-Payment: hashcash " ;; (number-to-string (hashcash-version pay)) " " ;; pay "\n") - (insert-before-markers "X-Hashcash: " pay "\n")))) + (insert-before-markers "X-Hashcash: " pay)))))) + +(defun hashcash-cancel-async (&optional buffer) + "Delete any hashcash processes associated with BUFFER. +BUFFER defaults to the current buffer." + (interactive) + (unless buffer (setq buffer (current-buffer))) + (let (entry) + (while (setq entry (rassq buffer hashcash-process-alist)) + (delete-process (car entry)) + (setq hashcash-process-alist + (delq entry hashcash-process-alist))))) + +(defun hashcash-wait-async (&optional buffer) + "Wait for asynchronous hashcash processes in BUFFER to finish. +BUFFER defaults to the current buffer." + (interactive) + (unless buffer (setq buffer (current-buffer))) + (let (entry) + (while (setq entry (rassq buffer hashcash-process-alist)) + (accept-process-output (car entry))))) + +(defun hashcash-processes-running-p (buffer) + "Return non-nil if hashcash processes in BUFFER are still running." + (rassq buffer hashcash-process-alist)) + +(defun hashcash-wait-or-cancel () + "Ask user whether to wait for hashcash processes to finish." + (interactive) + (when (hashcash-processes-running-p (current-buffer)) + (if (y-or-n-p + "Hashcash process(es) still running; wait for them to finish? ") + (hashcash-wait-async) + (hashcash-cancel-async)))) ;;;###autoload (defun hashcash-verify-payment (token &optional resource amount) @@ -182,9 +282,11 @@ is used instead.") (t nil)))) ;;;###autoload -(defun mail-add-payment (&optional arg) +(defun mail-add-payment (&optional arg async) "Add X-Payment: and X-Hashcash: headers with a hashcash payment -for each recipient address. Prefix arg sets default payment temporarily." +for each recipient address. Prefix arg sets default payment temporarily. +Set ASYNC to t to start asynchronous calculation. (See +`mail-add-payment-async')." (interactive "P") (let ((hashcash-default-payment (if arg (prefix-numeric-value arg) hashcash-default-payment)) @@ -206,10 +308,21 @@ for each recipient address. Prefix arg sets default payment temporarily." (when (and hashcash-in-news ng) (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) (when addrlist - (mapcar #'hashcash-insert-payment addrlist))))) ; mapc + (mapcar (if async + #'hashcash-insert-payment-async + #'hashcash-insert-payment) + addrlist))))) ; mapc t) ;;;###autoload +(defun mail-add-payment-async (&optional arg) + "Add X-Payment: and X-Hashcash: headers with a hashcash payment +for each recipient address. Prefix arg sets default payment temporarily. +Calculation is asynchronous." + (interactive "P") + (mail-add-payment arg t)) + +;;;###autoload (defun mail-check-payment (&optional arg) "Look for a valid X-Payment: or X-Hashcash: header. Prefix arg sets default accept amount temporarily." diff --git a/lisp/message.el b/lisp/message.el index 69f61f4..361d6e7 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -4250,10 +4250,11 @@ This sub function is for exclusive use of `message-send-mail'." (headers message-required-mail-headers) failure) (when message-generate-hashcash - (save-restriction - (message-narrow-to-headers) - (message-remove-header "X-Hashcash")) (message "Generating hashcash...") + ;; Wait for calculations already started to finish... + (hashcash-wait-async) + ;; ...and do calculations not already done. mail-add-payment + ;; will leave existing X-Hashcash headers alone. (mail-add-payment) (message "Generating hashcash...done")) (save-restriction @@ -6199,6 +6200,9 @@ are not included." (run-hooks 'message-header-setup-hook)) (set-buffer-modified-p nil) (setq buffer-undo-list nil) + (when message-generate-hashcash + ;; Generate hashcash headers for recipients already known + (mail-add-payment-async)) (run-hooks 'message-setup-hook) (message-position-point) (undo-boundary)) diff --git a/texi/ChangeLog b/texi/ChangeLog index 82346a4..5e41f3b 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +2004-11-14 Magnus Henoch + + * gnus.texi (Hashcash): New default value of + hashcash-default-payment. + 2004-10-26 Simon Josefsson * gnus.texi (Hashcash): Fix URL. Add pref to spam section. diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index ab9e10d..242a198 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -21614,8 +21614,7 @@ Headers,message-ja, The Message Manual}) をカスタマイズして下さい: @item hashcash-default-payment @vindex hashcash-default-payment この変数はハッシュの衝突を成すディフォルトのビット数を示します。規定値 -は 10 で、それはいささか低い値です。提唱されている有効な値は 17 か -ら 29 までの数です。 +は 20 です。提唱されている有効な値は 17 から 29 までの数です。 @item hashcash-payment-alist @vindex hashcash-payment-alist diff --git a/texi/gnus.texi b/texi/gnus.texi index 0ade938..2a688e3 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -22519,8 +22519,8 @@ You will need to set up some additional variables as well: @item hashcash-default-payment @vindex hashcash-default-payment This variable indicates the default number of bits the hash collision -should consist of. By default this is 10, which is a rather low -value. Suggested useful values include 17 to 29. +should consist of. By default this is 20. Suggested useful values +include 17 to 29. @item hashcash-payment-alist @vindex hashcash-payment-alist -- 1.7.10.4