nnimap.el (nnimap-get-groups): Use \\r rather than ^M in string literals
[gnus] / contrib / gnus-kill-to-score.el
1 ;;; gnus-kill-to-score.el --- translate simple kill files to score files
2 ;; Copyright (C) 1995 Free Software Foundation, Inc.
3
4 ;; Author: Ethan Bradford <ethanb@phys.washington.edu>
5 ;; Keywords: news
6
7 ;; This file is not part of GNU Emacs.
8
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)
12 ;; any later version.
13
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.
18
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.
22
23 ;;; Commentary:
24
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~).
27
28 ;;; Caveats:
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
36 ;;;     is t.
37 ;;;  -> If the kill file did anything funny with marks, it will be translated
38 ;;;     wrong.
39 ;;;  -> Doesn't delete comments, so won't delete file w/ only comments.
40
41 ;;; Code:
42
43 (require 'gnus)
44 (require 'gnus-score)
45 (load-library "gnus-kill")
46
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.")
50
51 (defun gnus-convert-kill-name-to-score-name (kill-file)
52   (concat
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)))
56    ".SCORE"))
57
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."
61   (interactive "f")
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)
68     (find-file kill-file)
69     (goto-char (point-min))
70     (gnus-kill-file-mode)
71     (while (progn
72              (setq beg (point))
73              (setq recognized nil)
74              (setq form (condition-case nil
75                             (read (current-buffer))
76                           (error nil))))
77       (setq command (car form))
78
79       (if (eq command 'load)
80           (let ((loaded-kill-file-name
81                  (condition-case nil
82                      (expand-file-name
83                       (gnus-convert-kill-name-to-score-name
84                        (eval (nth 1 form))))
85                    (error nil))))
86             (if (stringp loaded-kill-file-name)
87                 (progn
88                   (if (string-match
89                        (expand-file-name
90                         (or (file-name-directory gnus-kill-files-directory)
91                            "~/News/"))
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)
97                                (message
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))))
100                                  (if (= c ?A)
101                                      (setq gnus-convert-loads t)
102                                    (if (= c ?V)
103                                        (setq gnus-convert-loads 'never)))
104                                  (or (= c ?A) (= c ?Y) (= c ?\ )))))
105                       (progn
106                         (gnus-score-set 'files (list loaded-kill-file-name))
107                         (setq recognized t))))))
108
109         ;; The only other thing we understand is some form of gnus-kill
110         ;; Check all the fields because they influence whether we recognize.
111         (let
112             ((header (condition-case nil (eval (nth 1 form)) (error nil)))
113              (match (condition-case nil (eval (nth 2 form)) (error nil)))
114              (cmd (nth 3 form))
115              (all (condition-case nil (eval (nth 4 form)) (error nil)))
116              (date nil)
117              (score nil))               ;score also indicates if a cmd was
118                                       ;recognized.
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)))
126           (cond
127            ((eq command 'gnus-kill)
128             (cond
129              ((not cmd) ;; Simple kill
130               (setq score (- gnus-score-interactive-default-score)))
131
132              ((and (eq cmd 'gnus-summary-unkill) all) ;; An unkill
133               (setq score gnus-score-interactive-default-score))
134
135              ((not (listp cmd))) ; Only cmds w/ args from here on.
136
137              ((and (eq (car cmd) 'gnus-summary-mark-as-read) ;mod of standard
138                    (not (nth 1 cmd)))
139               (if (eqs (nth 2 cmd) " ")
140                   (if all 
141                       (setq score gnus-score-interactive-default-score))
142                 (setq score (- gnus-score-interactive-default-score))))
143
144              ((apply (lambda (c)        ; Matching the unkill in the FAQ
145                       (and (listp c)
146                            (eq (car c) 'gnus-summary-clear-mark-forward)
147                            (= (nth 1 c) 1)))
148                      (list (if (eq (car cmd) 'if) (nth 2 cmd) cmd)))
149               (setq score gnus-score-interactive-default-score))
150
151              ((and ;; Old (ding) gnus kill form.
152                (= (length cmd) 2)
153                (eq (car cmd) 'gnus-summary-raise-score))
154               (setq score (nth 1 cmd)))
155              ))
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)
162                 (progn
163                   (setq date (nth 2 form))
164                   (setq score (- gnus-score-interactive-default-score))))))
165           (if (and score (stringp header) (stringp match))
166               (progn
167                 (gnus-summary-score-entry
168                  header match 'r score date nil t)
169                 (setq recognized t)))))
170       (if recognized
171           (delete-region beg (point))
172         (message "Cannot convert this form:") (sit-for 0 500)
173         (print form) (sit-for 0 500)))
174
175     ;; Eliminate white space and delete the file if it is empty, else save.
176     (goto-char (point-min))
177     (delete-region (point)
178                    (progn
179                      (if (re-search-forward "[^ \t\n]" nil 'end)
180                          (backward-char 1))
181                      (point)))
182     (and (buffer-modified-p) (save-buffer))
183     (if (= (point-min) (point-max))
184         (progn
185           (message "Deleting %s; it is now empty." kill-file)
186           (delete-file kill-file))
187       (message "%s was not completed converted." kill-file))
188
189     (gnus-score-save)
190     (kill-buffer (current-buffer))))
191
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)))))