From: yamaoka <yamaoka>
Date: Tue, 16 Dec 2003 03:05:32 +0000 (+0000)
Subject: Synch to Gnus 200312160245.
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=605d924cd110a482459a50b4add2ba15358fb016;p=elisp%2Fgnus.git-

Synch to Gnus 200312160245.
---

diff --git a/contrib/hashcash.el b/contrib/hashcash.el
index 6702faf..84dfcae 100644
--- a/contrib/hashcash.el
+++ b/contrib/hashcash.el
@@ -1,7 +1,7 @@
 ;;; hashcash.el --- Add hashcash payments to email
 
-;; Copyright (C) 1997--2002 Paul E. Foley
 ;; Copyright (C) 2003 Free Software Foundation
+;; Copyright (C) 1997--2002 Paul E. Foley
 
 ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
 ;; Keywords: mail, hashcash
@@ -21,8 +21,6 @@
 
 ;;; Code:
 
-(eval-when-compile (require 'cl))
-
 (eval-and-compile
  (autoload 'executable-find "executable"))
 
@@ -61,38 +59,30 @@ is used instead.")
 
 (require 'mail-utils)
 
-(if (fboundp 'point-at-bol)
-    (defalias 'hashcash-point-at-bol 'point-at-bol)
-  (defalias 'hashcash-point-at-bol 'line-beginning-position))
+(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))
+ (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 (substring addr 0 (match-beginning 1))
-	      (substring addr (match-end 1)))
+  (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)))
-    (if val
-	(if (cddr val)
-	    (caddr val)
-	  (cadr val))
-      hashcash-default-payment)))
+    (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)))
-    (if val
-	(if (cddr val)
-	    (cadr val)
-	  (car val))
-      addr)))
+    (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."
@@ -101,7 +91,7 @@ is used instead.")
 	(set-buffer (get-buffer-create " *hashcash*"))
 	(erase-buffer)
 	(call-process hashcash-path nil t nil
-		      (concat "-b " (number-to-string val)) str)
+		      "-m" "-q" "-b" (number-to-string val) str)
 	(goto-char (point-min))
 	(buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol)))
     nil))
@@ -137,17 +127,17 @@ is used instead.")
   (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-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)
-		 (cadr (split-string token ":"))
-		 (caddr (split-string token ":")))))
+		 (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)
@@ -168,9 +158,7 @@ for each recipient address.  Prefix arg sets default payment temporarily."
     (save-excursion
       (save-restriction
 	(goto-char (point-min))
-	(re-search-forward (concat "^\\("
-				   (regexp-quote mail-header-separator)
-				   "\\)?$"))
+	(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)))
@@ -183,8 +171,8 @@ for each recipient address.  Prefix arg sets default payment temporarily."
 	    (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*"))))
 	  (when (and hashcash-in-news ng)
 	    (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
-	(while addrlist
-	  (hashcash-insert-payment (pop addrlist))))))
+	(when addrlist
+	  (mapcar #'hashcash-insert-payment addrlist))))) ; mapc
   t)
 
 ;;;###autoload