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