Synch to Oort Gnus.

diff --git a/contrib/ChangeLog b/contrib/ChangeLog
index f8271d6..da6cafd 100644 (file)
--- a/contrib/ChangeLog
+++ b/contrib/ChangeLog
@@ -1,3 +1,10 @@
+2003-02-21  Simon Josefsson  <jas@extundo.com>
+
+       * hashcash.el (hashcash-point-at-bol):
+       (hashcash-point-at-eol): Defalias.
+       (hashcash-generate-payment):
+       (mail-check-payment): Use it.
+
 2002-12-30  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * hashcash.el: New version from Paul Foley with new

diff --git a/contrib/hashcash.el b/contrib/hashcash.el
index 5ec251f..8dbc769 100644 (file)
--- a/contrib/hashcash.el
+++ b/contrib/hashcash.el
@@ -56,6 +56,16 @@ is used instead.")
 
 (require 'mail-utils)
 
+(defalias 'hashcash-point-at-bol
+  (if (fboundp 'point-at-bol)
+      'point-at-bol
+    'line-beginning-position))
+
+(defalias 'hashcash-point-at-eol
+  (if (fboundp 'point-at-eol)
+      '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))
@@ -90,7 +100,7 @@ is used instead.")
        (call-process hashcash nil t nil (concat "-b " (number-to-string val))
                      str)
        (goto-char (point-min))
-       (buffer-substring (point-at-bol) (point-at-eol)))
+       (buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol)))
     nil))
 
 (defun hashcash-check-payment (token str val)
@@ -170,11 +180,11 @@ Prefix arg sets default accept amount temporarily."
        (goto-char (point-min))
        (while (and (not ok) (search-forward "X-Payment: hashcash 1.1 " end t))
          (setq ok (hashcash-verify-payment
-                   (buffer-substring (point) (point-at-eol)))))
+                   (buffer-substring (point) (hashcash-point-at-eol)))))
        (goto-char (point-min))
        (while (and (not ok) (search-forward "X-Hashcash: " end t))
          (setq ok (hashcash-verify-payment
-                   (buffer-substring (point) (point-at-eol)))))
+                   (buffer-substring (point) (hashcash-point-at-eol)))))
        (when ok
          (message "Payment valid"))
        ok))))

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 317eef8..9147072 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,14 @@
+2003-02-21  Florian Weimer  <fw@deneb.enyo.de>
+       From Reiner Steib  <Reiner.Steib@gmx.de>.
+
+       * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New
+       variable, used in `gnus-button-mid-or-mail-heuristic'.
+       (gnus-button-mid-or-mail-heuristic): New function derived from
+       Florian Weimer's Perl script.
+       (gnus-button-handle-mid-or-mail): Allow a function instead of
+       'guess.
+       (gnus-button-guessed-mid-regexp): Removed.
+
 2003-02-20  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * message.el (message-resend): Bind message-setup-hook to nil;

diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el
index b36a471..8df097f 100644 (file)
--- a/lisp/gnus-art.el
+++ b/lisp/gnus-art.el
@@ -5944,57 +5944,171 @@ The function must take one argument, the string naming the URL."
   :group 'gnus-article-buttons
   :type 'regexp)
 
-(defcustom gnus-button-prefer-mid-or-mail 'guess
-  "What to do when the button on a string as \"foo123@bar.com\" is pushed.
-Strings like this can be either a message ID or a mail address.  If the
-variable is set to the symbol `ask', query the user what do do.  If it is the
-symbol `guess', Gnus will do a guess and query the user what do do if it is
-ambiguous.  See the variable `gnus-button-guessed-mid-regexp' for details
-concerning the guessing.  If it is one of the sybols `mid' or `mail', Gnus
-will always assume that the string is a message ID or a mail address,
-respectivly."
-  ;; FIXME: doc-string could/should be improved.
+(defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic
+  "What to do when the button on a string as \"foo123@bar.invalid\" is pushed.
+Strings like this can be either a message ID or a mail address.  If it is one
+of the symbols `mid' or `mail', Gnus will always assume that the string is a
+message ID or a mail address, respectivly.  If this variable is set to the
+symbol `ask', always query the user what do do.  If it is a function, this
+function will be called with the string as it's only argument.  The function
+must return `mid', `mail', `invalid' or `ask'."
   :group 'gnus-article-buttons
-  :type '(choice (const ask)
-                (const guess)
+  :type '(choice (function-item :tag "Heuristic function"
+                               gnus-button-mid-or-mail-heuristic)
+                (const ask)
                 (const mid)
                 (const mail)))
 
-(defcustom gnus-button-guessed-mid-regexp
-  (concat
-   "^<?\\(slrn\\|Pine\\.\\)"
-   "\\|\\.fsf@\\|\\.fsf_-_@\\|\\.ln@"
-   "\\|@4ax\\.com\\|@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de"
-         "\\|^<?.*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*[0-9].*@")
-  "Regular expression that matches message IDs and not mail addresses."
-  ;; TODO: Incorporate more matches from
-  ;; <URL:http://piology.org/perl/id-or-mail.pl.html>. I.e. translate the
-  ;; Perl-REs to Elisp-REs.
+(defcustom gnus-button-mid-or-mail-heuristic-alist
+  '((-10.0 . ".+\\$.+@")
+    (-10.0 . "#")
+    (-10.0 . "\\*")
+    (-5.0  . "\\+[^+]*\\+.*@") ;; # two plus signs
+    (-5.0  . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i
+    (-5.0  . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i;
+    (-1.0  . "^[^a-z]+@")
+   
+    (-5.0  . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@"
+    (-5.0  . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@"
+    (-3.0  . "[A-Z][A-Z][a-z][a-z].*@")
+    (-5.0  . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@")
+   
+    (-2.0  . "^[0-9]")
+    (-1.0  . "^[0-9][0-9]")
+    ;;
+    ;; -3.0 /^[0-9][0-9a-fA-F]{2,2}/;
+    (-3.0  . "^[0-9][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]")
+    ;; -5.0 /^[0-9][0-9a-fA-F]{3,3}/;
+    (-5.0  . "^[0-9][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]")
+    ;;
+    (-3.0  .  "[0-9][0-9][0-9][0-9][0-9][^0-9].*@") ;; "[0-9]{5,}.*\@"
+    (-3.0  .  "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][^0-9].*@")
+    ;;       "[0-9]{8,}.*\@"
+    (-3.0
+     . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@")
+    ;; "[0-9]{12,}.*\@"
+    ;;
+    (-20.0 . "\\.fsf@")        ;; Gnus
+    (-20.0 . "^slrn")
+    (-20.0 . "^Pine")
+    (-20.0 . "_-_") ;; Subject change in thread
+    ;;
+    (-20.0 . "\\.ln@") ;; leafnode
+    (-30.0 . "@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de")
+    (-30.0 . "@4[Aa][Xx]\\.com") ;; Forte Agent
+    ;;
+    ;; (5.0 . "") ;; $local_part_len <= 7
+    (10.0  . "^[^0-9]+@")
+    (3.0   . "^[^0-9]+[0-9][0-9]?[0-9]?@")
+    ;;      ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part
+    (3.0   . "\@stud")
+    ;;
+    (2.0   . "[a-z][a-z][._-][A-Z][a-z].*@")
+    ;;
+    (0.5   . "^[A-Z][a-z]")
+    (0.5   . "^[A-Z][a-z][a-z]")
+    (1.5   . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3}
+    (2.0   . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4}
+  "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
+
+A negative RATE indicates a message IDs, whereas a positive indicates a mail
+address.  The REGEXP is processed with `case-fold-search' set to `nil'."
   :group 'gnus-article-buttons
-  :type 'regexp)
+  :type '(repeat (cons (number :tag "Rate")
+                      (regexp :tag "Regexp"))))
+
+(defun gnus-button-mid-or-mail-heuristic (mid-or-mail)
+  "Guess whether MID-OR-MAIL is a message ID or a mail address.
+Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail
+address, `ask' if unsure and `invalid' if the string is invalid."
+  (let ((case-fold-search nil)
+       (list gnus-button-mid-or-mail-heuristic-alist)
+       (result 0) rate regexp lpartlen elem)
+    (setq lpartlen
+         (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1")))
+    (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen)
+    ;; Certain special cases...
+    (when (string-match
+          (concat
+           "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$" "\\|"
+           "^[0-9]+\.[0-9]+\@compuserve")
+          mid-or-mail)
+      (gnus-message 8 "`%s' is a known mail address.")
+      (setq result 'mail))
+    (when (string-match "@.*@\\| " mid-or-mail)
+      (gnus-message 8 "`%s' is invalid.")
+      (setq result 'invalid))
+    ;; Nothing more to do, if result is not a number here...
+    (when (numberp result)
+      (while list
+       (setq elem (car list)
+             rate (car elem)
+             regexp (cdr elem)
+             list (cdr list))
+       (when (string-match regexp mid-or-mail)
+         (setq result (+ result rate))
+         (gnus-message
+          9 "`%s' matched `%s', rate `%s', result `%s'."
+          mid-or-mail regexp rate result)))
+      (when (<= lpartlen 7)
+       (setq result (+ result 5.0))
+       (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'."
+                     mid-or-mail result))
+      (when (>= lpartlen 12)
+       (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail)
+       (cond
+        ((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail)
+         ;; Long local part should contain realname if e-mail address,
+         ;; too many digits: message-id.
+         ;; $score -= 5.0 + 0.1 * $local_part_len;
+         (setq rate (* -1.0 (+ 5.0 (* 0.1 lpartlen))))
+         (setq result (+ result rate))
+         (gnus-message
+          9 "Many digits in `%s', rate `%s', result `%s'."
+          mid-or-mail rate result))
+        ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@"
+                       mid-or-mail)
+         ;; Too few vowels [^aeiouy]{4,}.*\@
+         (setq result (+ result -5.0))
+         (gnus-message
+          9 "Few vowels in `%s', rate `%s', result `%s'."
+          mid-or-mail -5.0 result))
+        (t
+         (setq result (+ result 5.0))
+         (gnus-message
+          9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result)))))
+    (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result)
+    (cond
+     ;; Maybe we should make this a customizable alist: (condition . 'result)
+     ((< result -10.0) 'mid)
+     ((> result  10.0) 'mail)
+     (t 'ask))))
 
 (defun gnus-button-handle-mid-or-mail (mid-or-mail)
-  (let* ((pref gnus-button-prefer-mid-or-mail)
+  (let* ((pref gnus-button-prefer-mid-or-mail) guessed
         (url-mid (concat "news" ":" mid-or-mail))
         (url-mailto (concat "mailto" ":" mid-or-mail)))
     (gnus-message 9 "mid-or-mail=%s" mid-or-mail)
-    ;; If it looks like a MID (well known readers or servers) use 'mid,
-    ;; otherwise 'ask the user.
-    (if (eq pref 'guess)
-       (if (string-match gnus-button-guessed-mid-regexp mid-or-mail)
-           (setq pref 'mid)
-         (setq pref 'ask)))
+    (when (fboundp pref)
+      (setq guessed
+           ;; get rid of surrounding angles...
+           (funcall pref
+                    (gnus-replace-in-string mid-or-mail "^<\\|>$" "")))
+      (if (or (eq 'mid guessed) (eq 'mail guessed))
+         (setq pref guessed)
+       (setq pref 'ask)))
     (if (eq pref 'ask)
        (save-window-excursion
          (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? "))
              (setq pref 'mail)
            (setq pref 'mid))))
     (cond ((eq pref 'mid)
-          (gnus-message 9 "calling `gnus-button-handle-news' %s" url-mid)
+          (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid)
           (gnus-button-handle-news url-mid))
          ((eq pref 'mail)
-          (gnus-message 9 "calling `gnus-url-mailto'  %s" url-mailto)
-          (gnus-url-mailto url-mailto)))))
+          (gnus-message 8 "calling `gnus-url-mailto'  %s" url-mailto)
+          (gnus-url-mailto url-mailto))
+         (t (gnus-message 3 "Invalid string.")))))
 
 (defun gnus-button-handle-custom (url)
   "Follow a Custom URL."