Changes committed gnus/contrib (ChangeLog README gnus-kill-to-score.el)

"Reiner Steib" <[email protected]> Fri, 26 Dec 2008 16:59:52 +0100
Newsgroups gmane.emacs.gnus.commits
Message-ID <[email protected]>
   Added: gnus-kill-to-score.el
Modified: ChangeLog README

* README: Add gnus-kill-to-score.el.

* gnus-kill-to-score.el: New file from
<http://heim.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el>.


Index: ChangeLog
diff -u gnus/contrib/ChangeLog:7.79 gnus/contrib/ChangeLog:7.80
--- ChangeLog:7.79	Sat Dec  6 18:30:03 2008
+++ ChangeLog	Fri Dec 26 16:59:52 2008
@@ -1,3 +1,10 @@
+2008-12-26  Reiner Steib  <[email protected]>
+
+	* README: Add gnus-kill-to-score.el.
+
+	* gnus-kill-to-score.el: New file from
+	<http://heim.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el>.
+
 2008-11-10  Teodor Zlatanov  <[email protected]>
 
 	* smtpmail.el (smtpmail-open-stream): Use
Index: README
diff -u gnus/contrib/README:7.13 gnus/contrib/README:7.14
--- README:7.13	Thu Jun  5 22:55:41 2008
+++ README	Fri Dec 26 16:59:52 2008
@@ -24,6 +24,11 @@
 	with Namazu, which is a full-text search engine distributed at
 	<http://namazu.org>, and to browse its results with Gnus.
 
+gnus-kill-to-score.el
+
+	Convert kill files to score files.  See (info "(gnus)Converting Kill
+	Files").
+
 gpg-ring.el
 gpg.el
 
Index: gnus-kill-to-score.el
diff -u /dev/null gnus/contrib/gnus-kill-to-score.el:7.1
--- /dev/null	Fri Dec 26 16:59:52 2008
+++ gnus-kill-to-score.el	Fri Dec 26 16:59:52 2008
@@ -0,0 +1,206 @@
+;;; gnus-kill-to-score.el --- translate simple kill files to score files
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Ethan Bradford <[email protected]>
+;; Keywords: news
+
+;; This file is not part of GNU Emacs.
+
+;; 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.
+
+;; 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
+;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Commentary:
+
+;;; If you don't like the changes which were made, edit out the new code from
+;;; the SCORE file and revert the kill file from the backup (.KILL~).
+
+;;; Caveats:
+;;;  -> Sometimes commands in a kill file work together.  For example, killing
+;;;     the negative of a pattern used to be done by killing all, then
+;;;     unkilling.  If the unkill fails to translate (which is likely), the
+;;;     configuration will be invalid, with the kill translated to a
+;;;     score entry and the unkill left as a kill.
+;;;  -> The score entries are always applied to all entries in a file, unlike
+;;;     gnus-kill, which only applies to marked entries if the fourth argument
+;;;     is t.
+;;;  -> If the kill file did anything funny with marks, it will be translated
+;;;     wrong.
+;;;  -> Doesn't delete comments, so won't delete file w/ only comments.
+
+;;; Code:
+
+(require 'gnus)
+(require 'gnus-score)
+(load-library "gnus-kill")
+
+(defvar gnus-convert-loads nil
+  "If t, kill-file loads are converted to score-file loads.
+If nil, we ask whether to convert.  Otherwise we don't load or ask.")
+
+(defun gnus-convert-kill-name-to-score-name (kill-file)
+  (concat
+   (if (string-equal (file-name-nondirectory kill-file) "KILL")
+       (concat (file-name-directory kill-file) "all")
+     (substring kill-file 0 (string-match ".KILL$" kill-file)))
+   ".SCORE"))
+
+(defun gnus-convert-one-kill-file (kill-file)
+  "Convert (as far as possible) the elements of KILL-FILE into a score file.
+See also the variable gnus-convert-loads."
+  (interactive "f")
+  (let* ((mark-below (or gnus-summary-mark-below gnus-summary-default-score 0))
+	 (expunge-below gnus-summary-expunge-below)
+	 (score-file-name (gnus-convert-kill-name-to-score-name kill-file))
+	 beg form command recognized)
+    (message "Converting kill file %s..." kill-file)
+    (gnus-score-load score-file-name)
+    (find-file kill-file)
+    (goto-char (point-min))
+    (gnus-kill-file-mode)
+    (while (progn
+	     (setq beg (point))
+	     (setq recognized nil)
+	     (setq form (condition-case nil
+			    (read (current-buffer))
+			  (error nil))))
+      (setq command (car form))
+
+      (if (eq command 'load)
+	  (let ((loaded-kill-file-name
+		 (condition-case nil
+		     (expand-file-name
+		      (gnus-convert-kill-name-to-score-name
+		       (eval (nth 1 form))))
+		   (error nil))))
+	    (if (stringp loaded-kill-file-name)
+		(progn
+		  (if (string-match
+		       (expand-file-name
+			(or (file-name-directory gnus-kill-files-directory)
+			   "~/News/"))
+		       loaded-kill-file-name)
+		      (setq loaded-kill-file-name
+			    (substring loaded-kill-file-name (match-end 0))))
+		  (if (or (eq gnus-convert-loads t)
+			  (and (not gnus-convert-loads)
+			       (message
+				"Convert kill-file load to score-file load for %s (y, n, a=always, v=never)? " loaded-kill-file-name)
+			       (let ((c (upcase (read-char-exclusive))))
+				 (if (= c ?A)
+				     (setq gnus-convert-loads t)
+				   (if (= c ?V)
+				       (setq gnus-convert-loads 'never)))
+				 (or (= c ?A) (= c ?Y) (= c ?\ )))))
+		      (progn
+			(gnus-score-set 'files (list loaded-kill-file-name))
+			(setq recognized t))))))
+
+	;; The only other thing we understand is some form of gnus-kill
+	;; Check all the fields because they influence whether we recognize.
+	(let
+	    ((header (condition-case nil (eval (nth 1 form)) (error nil)))
+	     (match (condition-case nil (eval (nth 2 form)) (error nil)))
+	     (cmd (nth 3 form))
+	     (all (condition-case nil (eval (nth 4 form)) (error nil)))
+	     (date nil)
+	     (score nil))		;score also indicates if a cmd was
+				      ;recognized.
+	  (if (and (listp cmd) (or (eq (car cmd) 'quote)
+				   (eq (car cmd) 'function)))
+	      (setq cmd (nth 1 cmd)))
+	  (if (and (listp cmd) (eq (car cmd) 'lambda))
+	      (setq cmd (nth 2 cmd)))
+	  (if (and (listp cmd) (eq (length cmd) 1))
+	      (setq cmd (car cmd)))
+	  (cond
+	   ((eq command 'gnus-kill)
+	    (cond
+	     ((not cmd) ;; Simple kill
+	      (setq score (- gnus-score-interactive-default-score)))
+
+	     ((and (eq cmd 'gnus-summary-unkill) all) ;; An unkill
+	      (setq score gnus-score-interactive-default-score))
+
+	     ((not (listp cmd))) ; Only cmds w/ args from here on.
+
+	     ((and (eq (car cmd) 'gnus-summary-mark-as-read) ;mod of standard
+		   (not (nth 1 cmd)))
+	      (if (eqs (nth 2 cmd) " ")
+		  (if all 
+		      (setq score gnus-score-interactive-default-score))
+		(setq score (- gnus-score-interactive-default-score))))
+
+	     ((apply (lambda (c)	; Matching the unkill in the FAQ
+		      (and (listp c)
+			   (eq (car c) 'gnus-summary-clear-mark-forward)
+			   (= (nth 1 c) 1)))
+		     (list (if (eq (car cmd) 'if) (nth 2 cmd) cmd)))
+	      (setq score gnus-score-interactive-default-score))
+
+	     ((and ;; Old (ding) gnus kill form.
+	       (= (length cmd) 2)
+	       (eq (car cmd) 'gnus-summary-raise-score))
+	      (setq score (nth 1 cmd)))
+	     ))
+	   ((eq command 'gnus-raise)
+	    (setq score (nth 2 form)))
+	   ((eq command 'gnus-lower)
+	    (setq score (- (nth 2 form))))
+	   ((eq command 'expire-kill)
+	    (if (= (length form) 3)
+		(progn
+		  (setq date (nth 2 form))
+		  (setq score (- gnus-score-interactive-default-score))))))
+	  (if (and score (stringp header) (stringp match))
+	      (progn
+		(gnus-summary-score-entry
+		 header match 'r score date nil t)
+		(setq recognized t)))))
+      (if recognized
+	  (delete-region beg (point))
+	(message "Cannot convert this form:") (sit-for 0 500)
+	(print form) (sit-for 0 500)))
+
+    ;; Eliminate white space and delete the file if it is empty, else save.
+    (goto-char (point-min))
+    (delete-region (point)
+		   (progn
+		     (if (re-search-forward "[^ \t\n]" nil 'end)
+			 (backward-char 1))
+		     (point)))
+    (and (buffer-modified-p) (save-buffer))
+    (if (= (point-min) (point-max))
+	(progn
+	  (message "Deleting %s; it is now empty." kill-file)
+	  (delete-file kill-file))
+      (message "%s was not completed converted." kill-file))
+
+    (gnus-score-save)
+    (kill-buffer (current-buffer))))
+
+(defun gnus-convert-kill-file-directory (kill-directory)
+  "Convert kill files in KILL-DIRECTORY into score files.
+Uses gnus-convert-one-kill-file.
+See also the variable gnus-convert-loads."
+  (interactive "DDirectory to convert (empty string = current kill directory): ")
+  (if (string= kill-directory "")
+      (setq kill-directory (or gnus-kill-files-directory "~/News")))
+  (let ((all-kill-files (directory-files kill-directory)))
+    (while all-kill-files
+      (if (string-match "\\(.\\|^\\)KILL$" (car all-kill-files))
+	  (gnus-convert-one-kill-file
+	   (expand-file-name (car all-kill-files) kill-directory)))
+      (setq all-kill-files (cdr all-kill-files)))))
+
+