Synch to Oort Gnus 200304292153.
authoryamaoka <yamaoka>
Tue, 29 Apr 2003 22:20:55 +0000 (22:20 +0000)
committeryamaoka <yamaoka>
Tue, 29 Apr 2003 22:20:55 +0000 (22:20 +0000)
lisp/ChangeLog
lisp/dgnushack.el
lisp/gnus-art.el
lisp/gnus-registry.el
lisp/spam-report.el
lisp/spam-stat.el

index 1d4e643..5fb1692 100644 (file)
@@ -1,3 +1,32 @@
+2003-04-30  Steve Youngs  <youngs@xemacs.org>
+
+       * dgnushack.el: Add some missing autoloads for XEmacs 21.1.
+
+2003-04-29  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * gnus-registry.el (gnus-registry-fetch-group): faster
+       (gnus-registry-delete-group): new function
+       (gnus-registry-add-group): new function
+       (gnus-register-spool-action): use it
+       (gnus-register-action): use it
+       (gnus-registry-translate-from-alist) 
+       (gnus-registry-translate-to-alist): remove the headers registry
+       for now
+
+2003-04-29  Reiner Steib  <Reiner.Steib@gmx.de>
+
+       * gnus-art.el (gnus-button-alist): Fixed CTAN regexp.
+
+2003-04-29  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * spam-report.el (spam-report-gmane): gnus-summary-article-number
+       is not necessary, just use the function parameter
+
+2003-04-29  Karl Pflysterer  <sigurd@12move.de>
+
+       * spam-stat.el (spam-stat-save): No longer font-locks the file
+       when saving
+
 2003-04-29  Katsumi Yamaoka  <yamaoka@jpl.org>
 
        * canlock.el: Bind mail-header-separator when compiling (XEmacs
index e48b6bb..4aac7c8 100644 (file)
@@ -468,6 +468,11 @@ Try to re-configure with --with-addpath=FLIM_PATH and run make again.
 
 (eval-and-compile
   (when (featurep 'xemacs)
+    ;; XEmacs 21.1 needs some extra hand holding
+    (when (eq emacs-minor-version 1)
+      (autoload 'custom-declare-face "cus-face" nil t)
+      (autoload 'cl-compile-time-init "cl-macs" nil t)
+      (autoload 'defadvice "advice" nil nil 'macro))
     (autoload 'Info-directory "info" nil t)
     (autoload 'Info-menu "info" nil t)
     (autoload 'annotations-at "annotations")
index fa464f1..923599b 100644 (file)
@@ -6492,7 +6492,9 @@ positives are possible."
     ("\\bmailto:\\([^ \n\t]+\\)"
      0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
     ;; CTAN
-    ("\\bCTAN:[ \t\n]*\\([^>)!;:,'\n\t ]*\\)"
+    ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\("
+            gnus-button-ctan-directory-regexp
+            "[^][>)!;:,'\n\t ]+\\)")
      0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
     ((concat "\\btex-archive/\\("
             gnus-button-ctan-directory-regexp
@@ -6532,9 +6534,9 @@ positives are possible."
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
     ("`\\([a-z][-a-z0-9]+\\.el\\)'"
      1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
-    ("`\\([a-z]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
+    ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
      0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
-    ("`\\([a-z]+-[a-z]+\\)'"
+    ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
      0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
     ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
      1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
index 9d16500..e5aed7c 100644 (file)
@@ -41,7 +41,7 @@
   "*The article registry by Message ID.")
 
 (defvar gnus-registry-headers-hashtb nil
-  "*The article header registry by Message ID.")
+  "*The article header registry by Message ID.  Unused for now.")
 
 (defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue")
   "List of groups that gnus-registry-split-fancy-with-parent won't follow.
@@ -57,14 +57,10 @@ The group names are matched, they don't have to be fully qualified."
     (defalias 'puthash 'cl-puthash)))
 
 (defun gnus-registry-translate-to-alist ()
-  (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb))
-  (setq gnus-registry-headers-alist (hashtable-to-alist 
-                                    gnus-registry-headers-hashtb)))
+  (setq gnus-registry-alist (hashtable-to-alist gnus-registry-hashtb)))
 
 (defun gnus-registry-translate-from-alist ()
-  (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist))
-  (setq gnus-registry-headers-hashtb (alist-to-hashtable 
-                                     gnus-registry-headers-alist)))
+  (setq gnus-registry-hashtb (alist-to-hashtable gnus-registry-alist)))
 
 (defun alist-to-hashtable (alist)
   "Build a hashtable from the values in ALIST."
@@ -90,30 +86,28 @@ The group names are matched, they don't have to be fully qualified."
   (let* ((id (mail-header-id data-header))
        (from (gnus-group-guess-full-name from))
        (to (if to (gnus-group-guess-full-name to) nil))
-       (to-name (if to to "the Bit Bucket")))
+       (to-name (if to to "the Bit Bucket"))
+       (old-entry (gethash id gnus-registry-hashtb)))
     (gnus-message 5 "Registry: article %s %s from %s to %s"
                  id
                  (if method "respooling" "going")
                  from
-                 to)   
-    (unless (gethash id gnus-registry-headers-hashtb)
-      (puthash id (list data-header) gnus-registry-headers-hashtb))
-    (puthash id (cons (list action from to)
-                     (gethash id gnus-registry-hashtb)) 
-            gnus-registry-hashtb)))
+                 to)
+
+    (cond
+     ((equal 'delete action) (gnus-registry-delete-group id from))
+     (t (gnus-registry-add-group id to)))))
 
 (defun gnus-register-spool-action (id group)
   ;; do not process the draft IDs
 ;  (unless (string-match "totally-fudged-out-message-id" id)
-    (let ((group (gnus-group-guess-full-name group)))
-    (when (string-match "\r$" id)
-      (setq id (substring id 0 -1)))
-    (gnus-message 5 "Registry: article %s spooled to %s"
-                 id
-                 group)
-    (puthash id (cons (list 'spool nil group) 
-                     (gethash id gnus-registry-hashtb)) 
-            gnus-registry-hashtb)))
+;    (let ((group (gnus-group-guess-full-name group)))
+  (when (string-match "\r$" id)
+    (setq id (substring id 0 -1)))
+  (gnus-message 5 "Registry: article %s spooled to %s"
+               id
+               group)
+  (gnus-registry-add-group id group))
 ;)
 
 ;; Function for nn{mail|imap}-split-fancy: look up all references in
@@ -155,17 +149,38 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
            (string-match x word))
          list))))
 
-
 (defun gnus-registry-fetch-group (id)
   "Get the group of a message, based on the message ID.
 Returns the first place where the trail finds a spool action."
   (let ((trail (gethash id gnus-registry-hashtb)))
-    (dolist (crumb trail)
-      (let ((action (nth 0 crumb))
-           (from (nth 1 crumb))
-           (to (nth 2 crumb)))
-       (when (eq action 'spool)
-         (return to))))))
+    (if trail
+       (car trail)
+      nil)))
+
+(defun gnus-registry-delete-group (id group)
+  "Get the group of a message, based on the message ID.
+Returns the first place where the trail finds a spool action."
+  (let ((trail (gethash id gnus-registry-hashtb))
+       (group (gnus-group-short-name group)))
+    (puthash id (if trail
+                   (delete group trail)
+                 nil)
+    gnus-registry-hashtb))
+  ;; now, clear the entry if it's empty
+  (unless (gethash id gnus-registry-hashtb)
+    (remhash id gnus-registry-hashtb)))
+
+(defun gnus-registry-add-group (id group)
+  "Get the group of a message, based on the message ID.
+Returns the first place where the trail finds a spool action."
+  ;; make sure there are no duplicate entries
+  (let ((group (gnus-group-short-name group)))
+    (gnus-registry-delete-group id group)      
+    (let ((trail (gethash id gnus-registry-hashtb)))
+      (puthash id (if trail
+                     (cons group trail)
+                   (list group))
+              gnus-registry-hashtb))))
 
 (defun gnus-registry-clear ()
   "Clear the Gnus registry."
index fafb891..46884c4 100644 (file)
@@ -62,7 +62,7 @@ This is probably handled better with group/topic parameters."
          (spam-report-url-ping "spam.gmane.org" 
                    (format "/%s:%d"
                            (gnus-group-real-name gnus-newsgroup-name)
-                           (gnus-summary-article-number)))
+                           article))
        (with-current-buffer nntp-server-buffer
          (gnus-request-head article gnus-newsgroup-name)
          (goto-char (point-min))
index f4c5ec9..4c9093f 100644 (file)
@@ -398,7 +398,8 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
   "Save the `spam-stat' hash table as lisp file."
   (interactive)
   (with-temp-buffer
-    (let ((standard-output (current-buffer)))
+    (let ((standard-output (current-buffer))
+         (font-lock-maximum-size 0))
       (insert "(setq spam-stat-ngood "
               (number-to-string spam-stat-ngood)
               " spam-stat-nbad "
@@ -409,8 +410,8 @@ Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
                              (spam-stat-good entry)
                              (spam-stat-bad entry))))
               spam-stat)
-      (insert ")))"))
-    (write-file spam-stat-file)))
+      (insert ")))")
+    (write-file spam-stat-file))))
 
 (defun spam-stat-load ()
   "Read the `spam-stat' hash table from disk."