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