X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Flegacy-gnus-agent.el;h=ecde35dca8fbdf955a3912c3db520fed94567102;hb=873ba7b51ddfb07246cd874b7de72662308236c9;hp=e5c2ae4478384a8cff00d057b026d81748481664;hpb=125d88b46ad2efa065f06d5dac37a245b488985a;p=gnus diff --git a/lisp/legacy-gnus-agent.el b/lisp/legacy-gnus-agent.el index e5c2ae447..ecde35dca 100644 --- a/lisp/legacy-gnus-agent.el +++ b/lisp/legacy-gnus-agent.el @@ -1,10 +1,39 @@ +;;; gnus-agent.el --- Legacy unplugged support for Gnus + +;; Copyright (C) 2004-2012 Free Software Foundation, Inc. + +;; Author: Kevin Greiner +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Conversion functions for the Agent. + +;;; Code: (require 'gnus-start) (require 'gnus-util) (require 'gnus-range) (require 'gnus-agent) -; Oort Gnus v0.08 - This release updated agent to no longer use -; history file and to support a compressed alist. +;; Oort Gnus v0.08 - This release updated agent to no longer use +;; history file and to support a compressed alist. + +(defvar gnus-agent-compressed-agentview-search-only nil) (defun gnus-agent-convert-to-compressed-agentview (converting-to) "Iterates over all agentview files to ensure that they have been @@ -23,13 +52,20 @@ converted to the compressed format." ((file-directory-p member) (push member search-in)) ((equal (file-name-nondirectory member) ".agentview") - (setq converted-something + (setq converted-something (or (gnus-agent-convert-agentview member) converted-something)))))) (if converted-something (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to)))) +(defun gnus-agent-convert-to-compressed-agentview-prompt () + (catch 'found-file-to-convert + (let ((gnus-agent-compressed-agentview-search-only t)) + (gnus-agent-convert-to-compressed-agentview nil)))) + +(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt) + (defun gnus-agent-convert-agentview (file) "Load FILE and do a `read' there." (with-temp-buffer @@ -68,24 +104,24 @@ converted to the compressed format." (setq changed-version t))) (when changed-version + (when gnus-agent-compressed-agentview-search-only + (throw 'found-file-to-convert t)) + (erase-buffer) - (let ((compressed nil)) - (mapcar (lambda (pair) - (let* ((article-id (car pair)) - (day-of-download (cdr pair)) - (comp-list (assq day-of-download compressed))) - (if comp-list - (setcdr comp-list - (cons article-id (cdr comp-list))) - (setq compressed - (cons (list day-of-download article-id) - compressed))) - nil)) alist) - (mapcar (lambda (comp-list) - (setcdr comp-list - (gnus-compress-sequence - (nreverse (cdr comp-list))))) - compressed) + (let (article-id day-of-download comp-list compressed) + (while alist + (setq article-id (caar alist) + day-of-download (cdar alist) + comp-list (assq day-of-download compressed) + alist (cdr alist)) + (if comp-list + (setcdr comp-list (cons article-id (cdr comp-list))) + (push (list day-of-download article-id) compressed))) + (setq alist compressed) + (while alist + (setq comp-list (pop alist)) + (setcdr comp-list + (gnus-compress-sequence (nreverse (cdr comp-list))))) (princ compressed (current-buffer))) (insert "\n2\n") (write-file file) @@ -109,7 +145,7 @@ converted to the compressed format." (set-buffer buffer) (erase-buffer) (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ") - (let (print-level print-length) (pp gnus-agent-expire-days (current-buffer))) + (gnus-pp gnus-agent-expire-days) (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n") (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n") @@ -150,7 +186,7 @@ converted to the compressed format." (when (eq 0 (string-match (caar days) group)) - (throw 'found (cadar days))) + (throw 'found (cadr (car days)))) (setq days (cdr days))) nil))) (when day @@ -163,36 +199,38 @@ converted to the compressed format." (t t)))))) (kill-buffer buffer)) - (error "Change gnus-agent-expire-days to an integer for gnus to start.")))) + (error "Change gnus-agent-expire-days to an integer for gnus to start")))) ;; The gnus-agent-unlist-expire-days has its own conversion prompt. ;; Therefore, hide the default prompt. (gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t) (defun gnus-agent-unhook-expire-days (converting-to) - "Remove every lambda from gnus-group-prepare-hook that mention the -symbol gnus-agent-do-once in their definition. This should NOT be + "Remove every lambda from `gnus-group-prepare-hook' that mention the +symbol `gnus-agent-do-once' in their definition. This should NOT be necessary as gnus-agent.el no longer adds them. However, it is possible that the hook was persistently saved." - (let ((h t)) ; iterate from bgn of hook + (let ((h t)) ; Iterate from bgn of hook. (while h (let ((func (progn (when (eq h t) - ;; init h to list of functions + ;; Init h to list of functions. (setq h (cond ((listp gnus-group-prepare-hook) gnus-group-prepare-hook) ((boundp 'gnus-group-prepare-hook) (list gnus-group-prepare-hook))))) (pop h)))) - (when (cond ((eq (type-of func) 'compiled-function) - ;; Search def. of compiled function for gnus-agent-do-once string - (let* (definition - print-level + (when (cond ((byte-code-function-p func) + ;; Search def. of compiled function for + ;; gnus-agent-do-once string. + (let* (definition + print-level print-length (standard-output (lambda (char) (setq definition (cons char definition))))) - (princ func) ; populates definition with reversed list of characters + (princ func) ; Populates definition with reversed list + ; of characters. (let* ((i (length definition)) (s (make-string i 0))) (while definition @@ -200,7 +238,7 @@ possible that the hook was persistently saved." (string-match "\\bgnus-agent-do-once\\b" s)))) ((listp func) - (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda + (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; Handles eval'd lambda. )) (remove-hook 'gnus-group-prepare-hook func) @@ -212,4 +250,6 @@ possible that the hook was persistently saved." ;; the .newsrc.eld file. (gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t) -;;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a +(provide 'legacy-gnus-agent) + +;;; legacy-gnus-agent.el ends here