* lpath.el: Fbind string-as-multibyte for XEmacs.

[gnus] / lisp / hashcash.el

diff --git a/lisp/hashcash.el b/lisp/hashcash.el
index ae34425..7382345 100644 (file)
--- a/lisp/hashcash.el
+++ b/lisp/hashcash.el
@@ -20,8 +20,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -49,11 +49,16 @@
 
 ;;; Code:
 
+(defgroup hashcash nil
+  "Hashcash configuration."
+  :group 'mail)
+
 (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'."
-  :type 'integer)
+  :type 'integer
+  :group 'hashcash)
 
 (defcustom hashcash-payment-alist '()
   "*An association list mapping email addresses to payment amounts.
@@ -67,32 +72,39 @@ present, is the string to be hashed; if not present ADDR will be used."
                         (list :tag "Replace hash input"
                               (string :name "Address")
                               (string :name "Hash input")
-                              (integer :name "Amount")))))
+                              (integer :name "Amount"))))
+  :group 'hashcash)
 
 (defcustom hashcash-default-accept-payment 20
   "*The default minimum number of bits to accept on incoming payments."
-  :type 'integer)
+  :type 'integer
+  :group 'hashcash)
 
 (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.")
+is used instead."
+  :group 'hashcash)
 
 (defcustom hashcash-path (executable-find "hashcash")
-  "*The path to the hashcash binary.")
+  "*The path to the hashcash binary."
+  :group 'hashcash)
 
 (defcustom hashcash-extra-generate-parameters nil
   "*A list of parameter strings passed to `hashcash-path' when minting.
 For example, you may want to set this to '(\"-Z2\") to reduce header length."
-  :type '(repeat string))
+  :type '(repeat string)
+  :group 'hashcash)
 
 (defcustom hashcash-double-spend-database "hashcash.db"
-  "*The path to the double-spending database.")
+  "*The path to the double-spending database."
+  :group 'hashcash)
 
 (defcustom hashcash-in-news nil
   "*Specifies whether or not hashcash payments should be made to newsgroups."
-  :type 'boolean)
+  :type 'boolean
+  :group 'hashcash)
 
 (defvar hashcash-process-alist nil
   "Alist of asynchronous hashcash processes and buffers.")
@@ -198,7 +210,8 @@ Return immediately.  Call CALLBACK with process and result when ready."
   (save-excursion
     (save-restriction
       (message-narrow-to-headers-or-head)
-      (let ((token (message-fetch-field "x-hashcash")))
+      (let ((token (message-fetch-field "x-hashcash"))
+           (case-fold-search t))
        (and (stringp token)
             (string-match (regexp-quote recipient) token))))))
 
@@ -210,9 +223,6 @@ Return immediately.  Call CALLBACK with process and result when ready."
     (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
@@ -221,26 +231,23 @@ Return immediately.  Call CALLBACK with process and result when ready."
 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)))))
+    (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))))))
+  (when (buffer-live-p buffer)
+    (with-current-buffer buffer
+      (save-excursion
+       (save-restriction
+         (setq hashcash-process-alist (delq
+                                       (assq process hashcash-process-alist)
+                                       hashcash-process-alist))
+         (message-goto-eoh)
+         (when pay
+           (insert-before-markers "X-Hashcash: " pay)))))))
 
 (defun hashcash-cancel-async (&optional buffer)
   "Delete any hashcash processes associated with BUFFER.
@@ -305,10 +312,7 @@ Set ASYNC to t to start asynchronous calculation.  (See
        (addrlist nil))
     (save-excursion
       (save-restriction
-       (goto-char (point-min))
-       (search-forward mail-header-separator)
-       (beginning-of-line)
-       (narrow-to-region (point-min) (point))
+       (message-narrow-to-headers)
        (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"