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))))) + +