From: yamaoka <yamaoka>
Date: Mon, 27 Sep 2004 22:13:48 +0000 (+0000)
Subject: Synch to No Gnus 200409271949.
X-Git-Tag: t-gnus-6_17_4-quimby-~742
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=3645f727c877da6b3f8a46dbc476dc000b9ac75d;p=elisp%2Fgnus.git-

Synch to No Gnus 200409271949.
---

diff --git a/contrib/ChangeLog b/contrib/ChangeLog
index d386d84..fed0626 100644
--- a/contrib/ChangeLog
+++ b/contrib/ChangeLog
@@ -1,3 +1,7 @@
+2004-09-27  Simon Josefsson  <jas@extundo.com>
+
+	* hashcash.el: Move to ../lisp/.
+
 2004-07-30  TSUCHIYA Masatoshi  <tsuchiya@namazu.org>
 
 	* gnus-namazu.el (gnus-namazu/make-directory-table): Treat drive
diff --git a/contrib/hashcash.el b/contrib/hashcash.el
deleted file mode 100644
index 84dfcae..0000000
--- a/contrib/hashcash.el
+++ /dev/null
@@ -1,207 +0,0 @@
-;;; hashcash.el --- Add hashcash payments to email
-
-;; Copyright (C) 2003 Free Software Foundation
-;; Copyright (C) 1997--2002 Paul E. Foley
-
-;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
-;; Keywords: mail, hashcash
-
-;; Released under the GNU General Public License
-;;   (http://www.gnu.org/licenses/gpl.html)
-
-;;; Commentary:
-
-;; The hashcash binary is at http://www.cypherspace.org/hashcash/
-;;
-;; 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:
-;;    (add-hook 'message-send-hook 'mail-add-payment)
-
-;;; Code:
-
-(eval-and-compile
- (autoload 'executable-find "executable"))
-
-(defcustom hashcash-default-payment 0
-  "*The default number of bits to pay to unknown users.
-If this is zero, no payment header will be generated.
-See `hashcash-payment-alist'."
-  :type 'integer)
-
-(defcustom hashcash-payment-alist '()
-  "*An association list mapping email addresses to payment amounts.
-Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
-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
-  "*The default minimum number of bits to accept on incoming payments."
-  :type 'integer)
-
-(defcustom hashcash-accept-resources `((,user-mail-address nil))
-  "*An association list mapping hashcash resources to payment amounts.
-Resources named here are to be accepted in incoming payments.  If the
-corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
-is used instead.")
-
-(defcustom hashcash-path (executable-find "hashcash")
-  "*The path to the hashcash binary.")
-
-(defcustom hashcash-double-spend-database "hashcash.db"
-  "*The path to the double-spending database.")
-
-(defcustom hashcash-in-news nil
-  "*Specifies whether or not hashcash payments should be made to newsgroups."
-  :type 'boolean)
-
-(require 'mail-utils)
-
-(eval-and-compile
- (if (fboundp 'point-at-bol)
-     (defalias 'hashcash-point-at-bol 'point-at-bol)
-   (defalias 'hashcash-point-at-bol 'line-beginning-position))
-
- (if (fboundp 'point-at-eol)
-     (defalias 'hashcash-point-at-eol 'point-at-eol)
-   (defalias 'hashcash-point-at-eol 'line-end-position)))
-
-(defun hashcash-strip-quoted-names (addr)
-  (setq addr (mail-strip-quoted-names addr))
-  (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr))
-      (concat (match-string 1 addr) (match-string 2 addr))
-    addr))
-
-(defun hashcash-payment-required (addr)
-  "Return the hashcash payment value required for the given address."
-  (let ((val (assoc addr hashcash-payment-alist)))
-    (or (nth 2 val) (nth 1 val) hashcash-default-payment)))
-
-(defun hashcash-payment-to (addr)
-  "Return the string with which hashcash payments should collide."
-  (let ((val (assoc addr hashcash-payment-alist)))
-    (or (nth 1 val) (nth 0 val) addr)))
-
-(defun hashcash-generate-payment (str val)
-  "Generate a hashcash payment by finding a VAL-bit collison on STR."
-  (if (> val 0)
-      (save-excursion
-	(set-buffer (get-buffer-create " *hashcash*"))
-	(erase-buffer)
-	(call-process hashcash-path nil t nil
-		      "-m" "-q" "-b" (number-to-string val) str)
-	(goto-char (point-min))
-	(buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol)))
-    nil))
-
-(defun hashcash-check-payment (token str val)
-  "Check the validity of a hashcash payment."
-  (zerop (call-process hashcash-path nil nil nil "-c"
-		       "-d" "-f" hashcash-double-spend-database
-		       "-b" (number-to-string val)
-		       "-r" str
-		       token)))
-
-(defun hashcash-version (token)
-  "Find the format version of a hashcash token."
-  ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx
-  ;;   This carries its own version number embedded in the token,
-  ;;   so no further format number changes should be necessary
-  ;;   in the X-Payment header.
-  ;;
-  ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx
-  ;;   You need to upgrade your hashcash binary.
-  ;;
-  ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx
-  ;;   This is no longer supported.
-  (cond ((equal (aref token 1) ?:) 1.2)
-	((equal (aref token 6) ?:) 1.1)
-	(t (error "Unknown hashcash format version"))))
-
-;;;###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
-;      (insert-before-markers "X-Payment: hashcash "
-;			     (number-to-string (hashcash-version pay)) " "
-;			     pay "\n")
-      (insert-before-markers "X-Hashcash: " pay "\n"))))
-
-;;;###autoload
-(defun hashcash-verify-payment (token &optional resource amount)
-  "Verify a hashcash payment"
-  (let ((key (if (< (hashcash-version token) 1.2)
-		 (nth 1 (split-string token ":"))
-		 (nth 2 (split-string token ":")))))
-    (cond ((null resource)
-	   (let ((elt (assoc key hashcash-accept-resources)))
-	     (and elt (hashcash-check-payment token (car elt)
-			(or (cadr elt) hashcash-default-accept-payment)))))
-	  ((equal token key)
-	   (hashcash-check-payment token resource
-				(or amount hashcash-default-accept-payment)))
-	  (t nil))))
-
-;;;###autoload
-(defun mail-add-payment (&optional arg)
-  "Add X-Payment: and X-Hashcash: headers with a hashcash payment
-for each recipient address.  Prefix arg sets default payment temporarily."
-  (interactive "P")
-  (let ((hashcash-default-payment (if arg (prefix-numeric-value arg)
-				    hashcash-default-payment))
-	(addrlist nil))
-    (save-excursion
-      (save-restriction
-	(goto-char (point-min))
-	(search-forward mail-header-separator)
-	(beginning-of-line)
-	(narrow-to-region (point-min) (point))
-	(let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t)))
-	      (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t)))
-	      (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups"
-								 nil t))))
-	  (when to
-	    (setq addrlist (split-string to ",[ \t\n]*")))
-	  (when cc
-	    (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*"))))
-	  (when (and hashcash-in-news ng)
-	    (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
-	(when addrlist
-	  (mapcar #'hashcash-insert-payment addrlist))))) ; mapc
-  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."
-  (interactive "P")
-  (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg)
-					   hashcash-default-accept-payment))
-	(version (hashcash-version (hashcash-generate-payment "x" 1))))
-    (save-excursion
-      (goto-char (point-min))
-      (search-forward "\n\n")
-      (beginning-of-line)
-      (let ((end (point))
-	    (ok nil))
-	(goto-char (point-min))
-	(while (and (not ok) (search-forward "X-Payment: hashcash " end t))
-	  (let ((value (split-string
-			  (buffer-substring (point) (hashcash-point-at-eol))
-			  " ")))
-	    (when (equal (car value) (number-to-string version))
-	      (setq ok (hashcash-verify-payment (cadr value))))))
-	(goto-char (point-min))
-	(while (and (not ok) (search-forward "X-Hashcash: " end t))
-	  (setq ok (hashcash-verify-payment
-		    (buffer-substring (point) (hashcash-point-at-eol)))))
-	(when ok
-	  (message "Payment valid"))
-	ok))))
-
-(provide 'hashcash)
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index d73e732..eefaeb5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,23 @@
+2004-09-27  Jesper Harder  <harder@ifa.au.dk>
+
+	* gnus-cache.el (gnus-cache-possibly-remove-articles-1)
+	(gnus-cache-enter-article, gnus-cache-remove-article)
+	(gnus-cache-braid-heads, gnus-cache-generate-active): Use dolist.
+
+	* gnus-async.el (gnus-async-prefetch-remove-group): do.
+
+	* gnus-art.el (article-hide-boring-headers)
+	(article-translate-strings, article-display-face)
+	(gnus-article-mime-match-handle-first)
+	(gnus-article-highlight-headers)
+	(gnus-article-add-buttons-to-head): do.
+
+2004-09-27  Simon Josefsson  <jas@extundo.com>
+
+	* hashcash.el: New version, from
+	http://users.actrix.co.nz/mycroft/hashcash.el.  Previously in
+	../contrib/.
+
 2004-09-27  Katsumi Yamaoka  <yamaoka@jpl.org>
 
 	* mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte.
diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index 174c983..55e12a2 100644
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -1775,12 +1775,9 @@ always hide."
     (save-excursion
       (save-restriction
 	(let ((inhibit-read-only t)
-	      (list gnus-boring-article-headers)
-	      (inhibit-point-motion-hooks t)
-	      elem)
+	      (inhibit-point-motion-hooks t))
 	  (article-narrow-to-head)
-	  (while list
-	    (setq elem (pop list))
+	  (dolist (elem gnus-boring-article-headers)
 	    (goto-char (point-min))
 	    (cond
 	     ;; Hide empty headers.
@@ -1988,9 +1985,8 @@ characters to translate to."
 MAP is an alist where the elements are on the form (\"from\" \"to\")."
   (save-excursion
     (when (article-goto-body)
-      (let ((inhibit-read-only t)
-	    elem)
-	(while (setq elem (pop map))
+      (let ((inhibit-read-only t))
+	(dolist (elem map)
 	  (save-excursion
 	    (while (search-forward (car elem) nil t)
 	      (replace-match (cadr elem)))))))))
@@ -2214,7 +2210,7 @@ unfolded."
 	      (mail-narrow-to-head)
 	      (while (gnus-article-goto-header "Face")
 		(setq faces (nconc faces (list (mail-header-field-value)))))))
-	  (while (setq face (pop faces))
+	  (dolist (face faces)
 	    (let ((png (gnus-convert-face-to-png face))
 		  image)
 	      (when png
@@ -4743,8 +4739,8 @@ N is the numerical prefix."
 
 (defun gnus-article-mime-match-handle-first (condition)
   (if condition
-      (let ((alist gnus-article-mime-handle-alist) ihandle n)
-	(while (setq ihandle (pop alist))
+      (let (n)
+	(dolist (ihandle gnus-article-mime-handle-alist)
 	  (if (and (cond
 		    ((functionp condition)
 		     (funcall condition (cdr ihandle)))
@@ -6827,9 +6823,8 @@ do the highlighting.  See the documentation for those functions."
   "Highlight article headers as specified by `gnus-header-face-alist'."
   (interactive)
   (gnus-with-article-headers
-    (let ((alist gnus-header-face-alist)
-	  entry regexp header-face field-face from hpoints fpoints)
-      (while (setq entry (pop alist))
+    (let (regexp header-face field-face from hpoints fpoints)
+      (dolist (entry gnus-header-face-alist)
 	(goto-char (point-min))
 	(setq regexp (concat "^\\("
 			     (if (string-equal "" (nth 0 entry))
@@ -6934,11 +6929,9 @@ specified by `gnus-button-alist'."
   "Add buttons to the head of the article."
   (interactive)
   (gnus-with-article-headers
-    (let ((alist gnus-header-button-alist)
-	  entry beg end)
-      (while alist
+    (let (beg end)
+      (dolist (entry gnus-header-button-alist)
 	;; Each alist entry.
-	(setq entry (pop alist))
 	(goto-char (point-min))
 	(while (re-search-forward (car entry) nil t)
 	  ;; Each header matching the entry.
diff --git a/lisp/gnus-async.el b/lisp/gnus-async.el
index f3a43c9..86086a2 100644
--- a/lisp/gnus-async.el
+++ b/lisp/gnus-async.el
@@ -306,13 +306,11 @@ It should return non-nil if the article is to be prefetched."
   "Remove all articles belonging to GROUP from the prefetch buffer."
   (when (and (gnus-group-asynchronous-p group)
 	     (memq 'exit gnus-prefetched-article-deletion-strategy))
-    (let ((alist gnus-async-article-alist))
-      (save-excursion
-	(gnus-async-set-buffer)
-	(while alist
-	  (when (equal group (nth 3 (car alist)))
-	    (gnus-async-delete-prefetched-entry (car alist)))
-	  (pop alist))))))
+    (save-excursion
+      (gnus-async-set-buffer)
+      (dolist (entry gnus-async-article-alist)
+	(when (equal group (nth 3 entry))
+	  (gnus-async-delete-prefetched-entry entry))))))
 
 (defun gnus-async-prefetched-article-entry (group article)
   "Return the entry for ARTICLE in GROUP iff it has been prefetched."
diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el
index 1054b3f..8fad811 100644
--- a/lisp/gnus-cache.el
+++ b/lisp/gnus-cache.el
@@ -245,12 +245,10 @@ it's not cached."
 (defun gnus-cache-possibly-remove-articles-1 ()
   "Possibly remove some of the removable articles."
   (when (gnus-cache-fully-p gnus-newsgroup-name)
-    (let ((articles gnus-cache-removable-articles)
-	  (cache-articles gnus-newsgroup-cached)
-	  article)
+    (let ((cache-articles gnus-newsgroup-cached))
       (gnus-cache-change-buffer gnus-newsgroup-name)
-      (while articles
-	(when (memq (setq article (pop articles)) cache-articles)
+      (dolist (article gnus-cache-removable-articles)
+	(when (memq article cache-articles)
 	  ;; The article was in the cache, so we see whether we are
 	  ;; supposed to remove it from the cache.
 	  (gnus-cache-possibly-remove-article
@@ -334,9 +332,8 @@ it's not cached."
 If not given a prefix, use the process marked articles instead.
 Returns the list of articles entered."
   (interactive "P")
-  (let ((articles (gnus-summary-work-articles n))
-	article out)
-    (while (setq article (pop articles))
+  (let (out)
+    (dolist (article (gnus-summary-work-articles n))
       (gnus-summary-remove-process-mark article)
       (if (natnump article)
 	  (when (gnus-cache-possibly-enter-article
@@ -358,10 +355,8 @@ If not given a prefix, use the process marked articles instead.
 Returns the list of articles removed."
   (interactive "P")
   (gnus-cache-change-buffer gnus-newsgroup-name)
-  (let ((articles (gnus-summary-work-articles n))
-	article out)
-    (while articles
-      (setq article (pop articles))
+  (let (out)
+    (dolist (article (gnus-summary-work-articles n))
       (gnus-summary-remove-process-mark article)
       (when (gnus-cache-possibly-remove-article article nil nil nil t)
         (when gnus-newsgroup-agentized
@@ -547,35 +542,32 @@ Returns the list of articles removed."
 
 (defun gnus-cache-braid-heads (group cached)
   (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
-    (save-excursion
-      (set-buffer cache-buf)
+    (with-current-buffer cache-buf
       (erase-buffer))
     (set-buffer nntp-server-buffer)
     (goto-char (point-min))
-    (while cached
+    (dolist (entry cached)
       (while (and (not (eobp))
 		  (looking-at "2.. +\\([0-9]+\\) ")
 		  (< (progn (goto-char (match-beginning 1))
 			    (read (current-buffer)))
-		     (car cached)))
+		     entry))
 	(search-forward "\n.\n" nil 'move))
       (beginning-of-line)
-      (save-excursion
-	(set-buffer cache-buf)
-	(erase-buffer)
-	(let ((nnheader-file-coding-system gnus-cache-coding-system))
-	  (nnheader-insert-file-contents
-	   (gnus-cache-file-name group (car cached))))
-	(goto-char (point-min))
-	(insert "220 ")
-	(princ (car cached) (current-buffer))
-	(insert " Article retrieved.\n")
-	(search-forward "\n\n" nil 'move)
-	(delete-region (point) (point-max))
-	(forward-char -1)
-	(insert "."))
-      (insert-buffer-substring cache-buf)
-      (setq cached (cdr cached)))
+      (set-buffer cache-buf)
+      (erase-buffer)
+      (let ((nnheader-file-coding-system gnus-cache-coding-system))
+	(nnheader-insert-file-contents (gnus-cache-file-name group entry)))
+      (goto-char (point-min))
+      (insert "220 ")
+      (princ (car cached) (current-buffer))
+      (insert " Article retrieved.\n")
+      (search-forward "\n\n" nil 'move)
+      (delete-region (point) (point-max))
+      (forward-char -1)
+      (insert ".")
+      (set-buffer nntp-server-buffer)
+      (insert-buffer-substring cache-buf))
     (kill-buffer cache-buf)))
 
 ;;;###autoload
@@ -699,13 +691,12 @@ If LOW, update the lower bound instead."
       (gnus-sethash group (cons (car nums) (gnus-last-element nums))
 		    gnus-cache-active-hashtb))
     ;; Go through all the other files.
-    (while alphs
-      (when (and (file-directory-p (car alphs))
+    (dolist (file alphs)
+      (when (and (file-directory-p file)
 		 (not (string-match "^\\."
-				    (file-name-nondirectory (car alphs)))))
+				    (file-name-nondirectory file))))
 	;; We descend directories.
-	(gnus-cache-generate-active (car alphs)))
-      (setq alphs (cdr alphs)))
+	(gnus-cache-generate-active file)))
     ;; Write the new active file.
     (when top
       (gnus-cache-write-active t)
diff --git a/lisp/hashcash.el b/lisp/hashcash.el
new file mode 100644
index 0000000..15383a0
--- /dev/null
+++ b/lisp/hashcash.el
@@ -0,0 +1,232 @@
+;;; hashcash.el --- Add hashcash payments to email
+
+;; Copyright (C) 1997--2002 Paul E. Foley
+;; Copyright (C) 2003 Free Software Foundation
+
+;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
+;; Keywords: mail, hashcash
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; The hashcash binary is at http://www.cypherspace.org/hashcash/
+;;
+;; 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:
+;;    (add-hook 'message-send-hook 'mail-add-payment)
+
+;;; Code:
+
+(eval-and-compile
+ (autoload 'executable-find "executable"))
+
+(defcustom hashcash-default-payment 10
+  "*The default number of bits to pay to unknown users.
+If this is zero, no payment header will be generated.
+See `hashcash-payment-alist'."
+  :type 'integer)
+
+(defcustom hashcash-payment-alist '()
+  "*An association list mapping email addresses to payment amounts.
+Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
+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
+  "*The default minimum number of bits to accept on incoming payments."
+  :type 'integer)
+
+(defcustom hashcash-accept-resources `((,user-mail-address nil))
+  "*An association list mapping hashcash resources to payment amounts.
+Resources named here are to be accepted in incoming payments.  If the
+corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
+is used instead.")
+
+(defcustom hashcash-path (executable-find "hashcash")
+  "*The path to the hashcash binary.")
+
+(defcustom hashcash-double-spend-database "hashcash.db"
+  "*The path to the double-spending database.")
+
+(defcustom hashcash-in-news nil
+  "*Specifies whether or not hashcash payments should be made to newsgroups."
+  :type 'boolean)
+
+(require 'mail-utils)
+
+(eval-and-compile
+ (if (fboundp 'point-at-bol)
+     (defalias 'hashcash-point-at-bol 'point-at-bol)
+   (defalias 'hashcash-point-at-bol 'line-beginning-position))
+
+ (if (fboundp 'point-at-eol)
+     (defalias 'hashcash-point-at-eol 'point-at-eol)
+   (defalias 'hashcash-point-at-eol 'line-end-position)))
+
+(defun hashcash-strip-quoted-names (addr)
+  (setq addr (mail-strip-quoted-names addr))
+  (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr))
+      (concat (match-string 1 addr) (match-string 2 addr))
+    addr))
+
+(defun hashcash-token-substring ()
+  (save-excursion
+    (let ((token ""))
+      (loop
+	(setq token
+	  (concat token (buffer-substring (point) (hashcash-point-at-eol))))
+	(goto-char (hashcash-point-at-eol))
+	(forward-char 1)
+	(unless (looking-at "[ \t]") (return token))
+	(while (looking-at "[ \t]") (forward-char 1))))))
+
+(defun hashcash-payment-required (addr)
+  "Return the hashcash payment value required for the given address."
+  (let ((val (assoc addr hashcash-payment-alist)))
+    (or (nth 2 val) (nth 1 val) hashcash-default-payment)))
+
+(defun hashcash-payment-to (addr)
+  "Return the string with which hashcash payments should collide."
+  (let ((val (assoc addr hashcash-payment-alist)))
+    (or (nth 1 val) (nth 0 val) addr)))
+
+(defun hashcash-generate-payment (str val)
+  "Generate a hashcash payment by finding a VAL-bit collison on STR."
+  (if (> val 0)
+      (save-excursion
+	(set-buffer (get-buffer-create " *hashcash*"))
+	(erase-buffer)
+	(call-process hashcash-path nil t nil
+		      "-m" "-q" "-b" (number-to-string val) str)
+	(goto-char (point-min))
+	(hashcash-token-substring))
+    nil))
+
+(defun hashcash-check-payment (token str val)
+  "Check the validity of a hashcash payment."
+  (zerop (call-process hashcash-path nil nil nil "-c"
+		       "-d" "-f" hashcash-double-spend-database
+		       "-b" (number-to-string val)
+		       "-r" str
+		       token)))
+
+(defun hashcash-version (token)
+  "Find the format version of a hashcash token."
+  ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx
+  ;;   This carries its own version number embedded in the token,
+  ;;   so no further format number changes should be necessary
+  ;;   in the X-Payment header.
+  ;;
+  ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx
+  ;;   You need to upgrade your hashcash binary.
+  ;;
+  ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx
+  ;;   This is no longer supported.
+  (cond ((equal (aref token 1) ?:) 1.2)
+	((equal (aref token 6) ?:) 1.1)
+	(t (error "Unknown hashcash format version"))))
+
+;;;###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
+;;      (insert-before-markers "X-Payment: hashcash "
+;;			     (number-to-string (hashcash-version pay)) " "
+;;			     pay "\n")
+      (insert-before-markers "X-Hashcash: " pay "\n"))))
+
+;;;###autoload
+(defun hashcash-verify-payment (token &optional resource amount)
+  "Verify a hashcash payment"
+  (let* ((split (split-string token ":"))
+	 (key (if (< (hashcash-version token) 1.2)
+		  (nth 1 split)
+		  (case (string-to-number (nth 0 split))
+		    (0 (nth 2 split))
+		    (1 (nth 3 split))))))
+    (cond ((null resource)
+	   (let ((elt (assoc key hashcash-accept-resources)))
+	     (and elt (hashcash-check-payment token (car elt)
+			(or (cadr elt) hashcash-default-accept-payment)))))
+	  ((equal token key)
+	   (hashcash-check-payment token resource
+				(or amount hashcash-default-accept-payment)))
+	  (t nil))))
+
+;;;###autoload
+(defun mail-add-payment (&optional arg)
+  "Add X-Payment: and X-Hashcash: headers with a hashcash payment
+for each recipient address.  Prefix arg sets default payment temporarily."
+  (interactive "P")
+  (let ((hashcash-default-payment (if arg (prefix-numeric-value arg)
+				    hashcash-default-payment))
+	(addrlist nil))
+    (save-excursion
+      (save-restriction
+	(goto-char (point-min))
+	(search-forward mail-header-separator)
+	(beginning-of-line)
+	(narrow-to-region (point-min) (point))
+	(let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t)))
+	      (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t)))
+	      (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups"
+								 nil t))))
+	  (when to
+	    (setq addrlist (split-string to ",[ \t\n]*")))
+	  (when cc
+	    (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*"))))
+	  (when (and hashcash-in-news ng)
+	    (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
+	(when addrlist
+	  (mapcar #'hashcash-insert-payment addrlist))))) ; mapc
+  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."
+  (interactive "P")
+  (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg)
+					   hashcash-default-accept-payment))
+	(version (hashcash-version (hashcash-generate-payment "x" 1))))
+    (save-excursion
+      (goto-char (point-min))
+      (search-forward "\n\n")
+      (beginning-of-line)
+      (let ((end (point))
+	    (ok nil))
+	(goto-char (point-min))
+	(while (and (not ok) (search-forward "X-Payment: hashcash " end t))
+	  (let ((value (split-string (hashcash-token-substring) " ")))
+	    (when (equal (car value) (number-to-string version))
+	      (setq ok (hashcash-verify-payment (cadr value))))))
+	(goto-char (point-min))
+	(while (and (not ok) (search-forward "X-Hashcash: " end t))
+	  (setq ok (hashcash-verify-payment (hashcash-token-substring))))
+	(when ok
+	  (message "Payment valid"))
+	ok))))
+
+(provide 'hashcash)