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