X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fhashcash.el;h=cc3af11a47d860760e807c06136df16b780cd6ce;hb=76b6b2b0a969b427bb993110f6d8c05060cf5f64;hp=af766464add66f1f34f3188a55decc2177d46761;hpb=bd132df826bb76d7e366fd6e5a98fb4e4721d206;p=gnus diff --git a/lisp/hashcash.el b/lisp/hashcash.el index af766464a..cc3af11a4 100644 --- a/lisp/hashcash.el +++ b/lisp/hashcash.el @@ -1,6 +1,7 @@ ;;; hashcash.el --- Add hashcash payments to email -;; Copyright (C) 2003, 2004, 2005 Free Software Foundation +;; Copyright (C) 2003, 2004, 2005, 2007, 2008, 2009, 2010 +;; Free Software Foundation ;; Written by: Paul Foley (1997-2002) ;; Maintainer: Paul Foley @@ -8,20 +9,18 @@ ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. +;; the Free Software Foundation, either version 3 of the License, 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 +;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -49,6 +48,11 @@ ;;; Code: +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) + +(eval-when-compile (require 'cl)) ; for case + (defgroup hashcash nil "Hashcash configuration." :group 'mail) @@ -112,13 +116,13 @@ For example, you may want to set this to '(\"-Z2\") to reduce header length." (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-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)) @@ -126,6 +130,11 @@ For example, you may want to set this to '(\"-Z2\") to reduce header length." (concat (match-string 1 addr) (match-string 2 addr)) addr)) +(declare-function message-narrow-to-headers-or-head "message" ()) +(declare-function message-fetch-field "message" (header &optional not-all)) +(declare-function message-goto-eoh "message" ()) +(declare-function message-narrow-to-headers "message" ()) + (defun hashcash-token-substring () (save-excursion (let ((token "")) @@ -151,8 +160,7 @@ For example, you may want to set this to '(\"-Z2\") to reduce header length." "Generate a hashcash payment by finding a VAL-bit collison on STR." (if (and (> val 0) hashcash-path) - (save-excursion - (set-buffer (get-buffer-create " *hashcash*")) + (with-current-buffer (get-buffer-create " *hashcash*") (erase-buffer) (apply 'call-process hashcash-path nil t nil "-m" "-q" "-b" (number-to-string val) str @@ -164,7 +172,8 @@ For example, you may want to set this to '(\"-Z2\") to reduce header length." (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) + (if (and (> val 0) + hashcash-path) (let ((process (apply 'start-process "hashcash" nil hashcash-path "-m" "-q" "-b" (number-to-string val) str @@ -174,7 +183,7 @@ Return immediately. Call CALLBACK with process and result when ready." hashcash-process-alist)) (set-process-filter process `(lambda (process output) (funcall ,callback process output)))) - (funcall callback nil))) + (funcall callback nil nil))) (defun hashcash-check-payment (token str val) "Check the validity of a hashcash payment." @@ -223,9 +232,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 @@ -234,24 +240,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)) - (message-goto-eoh) - (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. @@ -271,7 +276,7 @@ BUFFER defaults to the current buffer." (unless buffer (setq buffer (current-buffer))) (let (entry) (while (setq entry (rassq buffer hashcash-process-alist)) - (accept-process-output (car entry))))) + (accept-process-output (car entry) 1)))) (defun hashcash-processes-running-p (buffer) "Return non-nil if hashcash processes in BUFFER are still running." @@ -281,7 +286,7 @@ BUFFER defaults to the current buffer." "Ask user whether to wait for hashcash processes to finish." (interactive) (when (hashcash-processes-running-p (current-buffer)) - (if (y-or-n-p + (if (y-or-n-p "Hashcash process(es) still running; wait for them to finish? ") (hashcash-wait-async) (hashcash-cancel-async)))) @@ -328,10 +333,10 @@ Set ASYNC to t to start asynchronous calculation. (See (when (and hashcash-in-news ng) (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*"))))) (when addrlist - (mapcar (if async - #'hashcash-insert-payment-async - #'hashcash-insert-payment) - addrlist))))) ; mapc + (mapc (if async + #'hashcash-insert-payment-async + #'hashcash-insert-payment) + addrlist))))) t) ;;;###autoload @@ -370,4 +375,4 @@ Prefix arg sets default accept amount temporarily." (provide 'hashcash) -;;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62 +;;; hashcash.el ends here