1 ;;; gnus-kill-to-score.el --- translate simple kill files to score files
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
4 ;; Author: Ethan Bradford <ethanb@phys.washington.edu>
7 ;; This file is not part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; GNU Emacs is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to
21 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25 ;;; If you don't like the changes which were made, edit out the new code from
26 ;;; the SCORE file and revert the kill file from the backup (.KILL~).
29 ;;; -> Sometimes commands in a kill file work together. For example, killing
30 ;;; the negative of a pattern used to be done by killing all, then
31 ;;; unkilling. If the unkill fails to translate (which is likely), the
32 ;;; configuration will be invalid, with the kill translated to a
33 ;;; score entry and the unkill left as a kill.
34 ;;; -> The score entries are always applied to all entries in a file, unlike
35 ;;; gnus-kill, which only applies to marked entries if the fourth argument
37 ;;; -> If the kill file did anything funny with marks, it will be translated
39 ;;; -> Doesn't delete comments, so won't delete file w/ only comments.
45 (load-library "gnus-kill")
47 (defvar gnus-convert-loads nil
48 "If t, kill-file loads are converted to score-file loads.
49 If nil, we ask whether to convert. Otherwise we don't load or ask.")
51 (defun gnus-convert-kill-name-to-score-name (kill-file)
53 (if (string-equal (file-name-nondirectory kill-file
) "KILL")
54 (concat (file-name-directory kill-file
) "all")
55 (substring kill-file
0 (string-match ".KILL$" kill-file
)))
58 (defun gnus-convert-one-kill-file (kill-file)
59 "Convert (as far as possible) the elements of KILL-FILE into a score file.
60 See also the variable gnus-convert-loads."
62 (let* ((mark-below (or gnus-summary-mark-below gnus-summary-default-score
0))
63 (expunge-below gnus-summary-expunge-below
)
64 (score-file-name (gnus-convert-kill-name-to-score-name kill-file
))
65 beg form command recognized
)
66 (message "Converting kill file %s..." kill-file
)
67 (gnus-score-load score-file-name
)
69 (goto-char (point-min))
74 (setq form
(condition-case nil
75 (read (current-buffer))
77 (setq command
(car form
))
79 (if (eq command
'load
)
80 (let ((loaded-kill-file-name
83 (gnus-convert-kill-name-to-score-name
86 (if (stringp loaded-kill-file-name
)
90 (or (file-name-directory gnus-kill-files-directory
)
92 loaded-kill-file-name
)
93 (setq loaded-kill-file-name
94 (substring loaded-kill-file-name
(match-end 0))))
95 (if (or (eq gnus-convert-loads t
)
96 (and (not gnus-convert-loads
)
98 "Convert kill-file load to score-file load for %s (y, n, a=always, v=never)? " loaded-kill-file-name
)
99 (let ((c (upcase (read-char-exclusive))))
101 (setq gnus-convert-loads t
)
103 (setq gnus-convert-loads
'never
)))
104 (or (= c ?A
) (= c ?Y
) (= c ?\
)))))
106 (gnus-score-set 'files
(list loaded-kill-file-name
))
107 (setq recognized t
))))))
109 ;; The only other thing we understand is some form of gnus-kill
110 ;; Check all the fields because they influence whether we recognize.
112 ((header (condition-case nil
(eval (nth 1 form
)) (error nil
)))
113 (match (condition-case nil
(eval (nth 2 form
)) (error nil
)))
115 (all (condition-case nil
(eval (nth 4 form
)) (error nil
)))
117 (score nil
)) ;score also indicates if a cmd was
119 (if (and (listp cmd
) (or (eq (car cmd
) 'quote
)
120 (eq (car cmd
) 'function
)))
121 (setq cmd
(nth 1 cmd
)))
122 (if (and (listp cmd
) (eq (car cmd
) 'lambda
))
123 (setq cmd
(nth 2 cmd
)))
124 (if (and (listp cmd
) (eq (length cmd
) 1))
125 (setq cmd
(car cmd
)))
127 ((eq command
'gnus-kill
)
129 ((not cmd
) ;; Simple kill
130 (setq score
(- gnus-score-interactive-default-score
)))
132 ((and (eq cmd
'gnus-summary-unkill
) all
) ;; An unkill
133 (setq score gnus-score-interactive-default-score
))
135 ((not (listp cmd
))) ; Only cmds w/ args from here on.
137 ((and (eq (car cmd
) 'gnus-summary-mark-as-read
) ;mod of standard
139 (if (eqs (nth 2 cmd
) " ")
141 (setq score gnus-score-interactive-default-score
))
142 (setq score
(- gnus-score-interactive-default-score
))))
144 ((apply (lambda (c) ; Matching the unkill in the FAQ
146 (eq (car c
) 'gnus-summary-clear-mark-forward
)
148 (list (if (eq (car cmd
) 'if
) (nth 2 cmd
) cmd
)))
149 (setq score gnus-score-interactive-default-score
))
151 ((and ;; Old (ding) gnus kill form.
153 (eq (car cmd
) 'gnus-summary-raise-score
))
154 (setq score
(nth 1 cmd
)))
156 ((eq command
'gnus-raise
)
157 (setq score
(nth 2 form
)))
158 ((eq command
'gnus-lower
)
159 (setq score
(- (nth 2 form
))))
160 ((eq command
'expire-kill
)
161 (if (= (length form
) 3)
163 (setq date
(nth 2 form
))
164 (setq score
(- gnus-score-interactive-default-score
))))))
165 (if (and score
(stringp header
) (stringp match
))
167 (gnus-summary-score-entry
168 header match
'r score date nil t
)
169 (setq recognized t
)))))
171 (delete-region beg
(point))
172 (message "Cannot convert this form:") (sit-for 0 500)
173 (print form
) (sit-for 0 500)))
175 ;; Eliminate white space and delete the file if it is empty, else save.
176 (goto-char (point-min))
177 (delete-region (point)
179 (if (re-search-forward "[^ \t\n]" nil
'end
)
182 (and (buffer-modified-p) (save-buffer))
183 (if (= (point-min) (point-max))
185 (message "Deleting %s; it is now empty." kill-file
)
186 (delete-file kill-file
))
187 (message "%s was not completed converted." kill-file
))
190 (kill-buffer (current-buffer))))
192 (defun gnus-convert-kill-file-directory (kill-directory)
193 "Convert kill files in KILL-DIRECTORY into score files.
194 Uses gnus-convert-one-kill-file.
195 See also the variable gnus-convert-loads."
196 (interactive "DDirectory to convert (empty string = current kill directory): ")
197 (if (string= kill-directory
"")
198 (setq kill-directory
(or gnus-kill-files-directory
"~/News")))
199 (let ((all-kill-files (directory-files kill-directory
)))
200 (while all-kill-files
201 (if (string-match "\\(.\\|^\\)KILL$" (car all-kill-files
))
202 (gnus-convert-one-kill-file
203 (expand-file-name (car all-kill-files
) kill-directory
)))
204 (setq all-kill-files
(cdr all-kill-files
)))))