cgit.sxemacs.org Git - gnus/blob - lisp/legacy-gnus-agent.el

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