Import Gnus v5.10.3.

[elisp/gnus.git-] / contrib / hashcash.el

diff --git a/contrib/hashcash.el b/contrib/hashcash.el
index 8a3ab4e..d130bb2 100644 (file)
--- a/contrib/hashcash.el
+++ b/contrib/hashcash.el
@@ -1,8 +1,8 @@
 ;;; hashcash.el --- Add hashcash payments to email
 
-;; $Revision: 1.1.1.4 $
-;; Copyright (C) 1997--2002 Paul E. Foley
+;; $Revision: 1.1.1.5 $
 ;; Copyright (C) 2003 Free Software Foundation
+;; Copyright (C) 1997--2002 Paul E. Foley
 
 ;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
 ;; Keywords: mail, hashcash
@@ -60,37 +60,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 (subseq addr 0 (match-beginning 1)) (subseq 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."
@@ -99,7 +92,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))
@@ -135,17 +128,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)
@@ -180,7 +173,7 @@ 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
-         (mapc #'hashcash-insert-payment addrlist)))))
+         (mapcar #'hashcash-insert-payment addrlist))))) ; mapc
   t)
 
 ;;;###autoload