lisp/gnus/legacy-gnus-agent.el

   1 ;;; gnus-agent.el --- Legacy unplugged support for Gnus
   2
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Kevin Greiner <kgreiner@xpediantsolutions.com>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 3, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Conversion functions for the Agent.
  28
  29 ;;; Code:
  30 (require 'gnus-start)
  31 (require 'gnus-util)
  32 (require 'gnus-range)
  33 (require 'gnus-agent)
  34
  35 ;; Oort Gnus v0.08 - This release updated agent to no longer use
  36 ;;                   history file and to support a compressed alist.
  37
  38 (defvar gnus-agent-compressed-agentview-search-only nil)
  39
  40 (defun gnus-agent-convert-to-compressed-agentview (converting-to)
  41   "Iterates over all agentview files to ensure that they have been
  42 converted to the compressed format."
  43
  44   (let ((search-in (list gnus-agent-directory))
  45         here
  46         members
  47         member
  48         converted-something)
  49     (while (setq here (pop search-in))
  50       (setq members (directory-files here t))
  51       (while (setq member (pop members))
  52         (cond ((string-match "/\\.\\.?$" member)
  53                nil)
  54               ((file-directory-p member)
  55                (push member search-in))
  56               ((equal (file-name-nondirectory member) ".agentview")
  57                (setq converted-something
  58                      (or (gnus-agent-convert-agentview member)
  59                          converted-something))))))
  60
  61     (if converted-something
  62         (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to))))
  63
  64 (defun gnus-agent-convert-to-compressed-agentview-prompt ()
  65   (catch 'found-file-to-convert
  66     (let ((gnus-agent-compressed-agentview-search-only t))
  67       (gnus-agent-convert-to-compressed-agentview nil))))
  68
  69 (gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt)
  70
  71 (defun gnus-agent-convert-agentview (file)
  72   "Load FILE and do a `read' there."
  73   (with-temp-buffer
  74       (nnheader-insert-file-contents file)
  75       (goto-char (point-min))
  76       (let ((inhibit-quit t)
  77             (alist (read (current-buffer)))
  78             (version (condition-case nil (read (current-buffer))
  79                        (end-of-file 0)))
  80             changed-version
  81             history-file)
  82
  83         (cond
  84          ((= version 0)
  85           (let (entry
  86                 (gnus-command-method nil))
  87             (mm-disable-multibyte) ;; everything is binary
  88             (erase-buffer)
  89             (insert "\n")
  90             (let ((file (concat (file-name-directory file) "/history")))
  91               (when (file-exists-p file)
  92                 (nnheader-insert-file-contents file)
  93                 (setq history-file file)))
  94
  95             (goto-char (point-min))
  96             (while (not (eobp))
  97               (if (and (looking-at
  98                         "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
  99                        (string= (gnus-agent-article-name ".agentview" (match-string 2))
 100                                 file)
 101                        (setq entry (assoc (string-to-number (match-string 3)) alist)))
 102                   (setcdr entry (string-to-number (match-string 1))))
 103               (forward-line 1))
 104             (setq changed-version t)))
 105          ((= version 1)
 106           (setq changed-version t)))
 107
 108         (when changed-version
 109           (when gnus-agent-compressed-agentview-search-only
 110             (throw 'found-file-to-convert t))
 111
 112           (erase-buffer)
 113           (let (article-id day-of-download comp-list compressed)
 114             (while alist
 115               (setq article-id (caar alist)
 116                     day-of-download (cdar alist)
 117                     comp-list (assq day-of-download compressed)
 118                     alist (cdr alist))
 119               (if comp-list
 120                   (setcdr comp-list (cons article-id (cdr comp-list)))
 121                 (push (list day-of-download article-id) compressed)))
 122             (setq alist compressed)
 123             (while alist
 124               (setq comp-list (pop alist))
 125               (setcdr comp-list
 126                       (gnus-compress-sequence (nreverse (cdr comp-list)))))
 127             (princ compressed (current-buffer)))
 128           (insert "\n2\n")
 129           (write-file file)
 130           (when history-file
 131             (delete-file history-file))
 132           t))))
 133
 134 ;; End of Oort Gnus v0.08 updates
 135
 136 ;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus
 137 ;;                from previous versions.  Therefore, the previous
 138 ;;                hacks to handle a gnus-agent-expire-days that
 139 ;;                specifies a list of values can be removed.
 140
 141 (defun gnus-agent-unlist-expire-days (converting-to)
 142   (when (listp gnus-agent-expire-days)
 143     (let (buffer)
 144       (unwind-protect
 145           (save-window-excursion
 146             (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*"))
 147             (set-buffer buffer)
 148             (erase-buffer)
 149             (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n  ")
 150             (gnus-pp gnus-agent-expire-days)
 151
 152             (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n")
 153             (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")
 154             (insert "expiration days to individual groups, you must instead set the\n")
 155             (insert "'agent-days-until-old group and/or topic parameter.\n")
 156             (insert "\n")
 157             (insert "If you would like, gnus can iterate over every group comparing its name to the\n")
 158             (insert "regular expressions that you currently have in gnus-agent-expire-days.  When\n")
 159             (insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n")
 160             (insert "parameter to the value associated with the regular expression.\n")
 161             (insert "\n")
 162             (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n")
 163             (insert "ERROR as soon as this function completes.  The reason is that you must\n")
 164             (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n")
 165             (insert "to set it to an integer before gnus can be used.\n")
 166             (insert "\n")
 167             (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n")
 168             (insert "execute past this function.\n")
 169             (insert "\n")
 170             (insert "Should gnus use gnus-agent-expire-days to assign\n")
 171             (insert "agent-days-until-old parameters to individual groups? (Y/N)")
 172
 173             (switch-to-buffer buffer)
 174             (beep)
 175             (beep)
 176
 177             (let ((echo-keystrokes 0)
 178                   c)
 179               (while (progn (setq c (read-char-exclusive))
 180                             (cond ((or (eq c ?y) (eq c ?Y))
 181                                          (save-excursion
 182                                            (let ((groups (gnus-group-listed-groups)))
 183                                              (while groups
 184                                                (let* ((group (pop groups))
 185                                                       (days gnus-agent-expire-days)
 186                                                       (day (catch 'found
 187                                                              (while days
 188                                                                (when (eq 0 (string-match
 189                                                                             (caar days)
 190                                                                             group))
 191                                                                  (throw 'found (cadar days)))
 192                                                                (setq days (cdr days)))
 193                                                              nil)))
 194                                                  (when day
 195                                                    (gnus-group-set-parameter group 'agent-days-until-old
 196                                                                              day))))))
 197                                    nil
 198                                    )
 199                                   ((or (eq c ?n) (eq c ?N))
 200                                    nil)
 201                                   (t
 202                                    t))))))
 203         (kill-buffer buffer))
 204       (error "Change gnus-agent-expire-days to an integer for gnus to start"))))
 205
 206 ;; The gnus-agent-unlist-expire-days has its own conversion prompt.
 207 ;; Therefore, hide the default prompt.
 208 (gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
 209
 210 (defun gnus-agent-unhook-expire-days (converting-to)
 211   "Remove every lambda from gnus-group-prepare-hook that mention the
 212 symbol gnus-agent-do-once in their definition.  This should NOT be
 213 necessary as gnus-agent.el no longer adds them.  However, it is
 214 possible that the hook was persistently saved."
 215     (let ((h t)) ; iterate from bgn of hook
 216       (while h
 217         (let ((func (progn (when (eq h t)
 218                              ;; init h to list of functions
 219                              (setq h (cond ((listp gnus-group-prepare-hook)
 220                                             gnus-group-prepare-hook)
 221                                            ((boundp 'gnus-group-prepare-hook)
 222                                             (list gnus-group-prepare-hook)))))
 223                            (pop h))))
 224
 225           (when (cond ((eq (type-of func) 'compiled-function)
 226                        ;; Search def. of compiled function for gnus-agent-do-once string
 227                        (let* (definition
 228                                print-level
 229                                print-length
 230                                (standard-output
 231                                 (lambda (char)
 232                                   (setq definition (cons char definition)))))
 233                          (princ func) ; populates definition with reversed list of characters
 234                          (let* ((i (length definition))
 235                                 (s (make-string i 0)))
 236                            (while definition
 237                              (aset s (setq i (1- i)) (pop definition)))
 238
 239                            (string-match "\\bgnus-agent-do-once\\b" s))))
 240                       ((listp func)
 241                        (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda
 242                        ))
 243
 244             (remove-hook 'gnus-group-prepare-hook func)
 245             ;; I don't what remove-hook is going to actually do to the
 246             ;; hook list so start over from the beginning.
 247             (setq h t))))))
 248
 249 ;; gnus-agent-unhook-expire-days is safe in that it does not modify
 250 ;; the .newsrc.eld file.
 251 (gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t)
 252
 253 (provide 'legacy-gnus-agent)
 254
 255 ;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a
 256 ;;; legacy-gnus-agent.el ends here