X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-agent.el;h=f83fb8942176e4ea7d765c43e06d721567321550;hb=b74fac078f05fa78c65ef6ac22a644331120f096;hp=0dcc8c4e1362fbf72a5916dca14486d2b50ea3a7;hpb=d23333cd3e2e51d74c6565bbb7ee6ca9f96fe18c;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 0dcc8c4..f83fb89 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -224,6 +224,17 @@ unplugged." :group 'gnus-agent :type 'boolean) +(defcustom gnus-agent-article-alist-save-format 1 + "Indicates whether to use compression(2), verses no + compression(1), when writing agentview files. The compressed + files do save space but load times are 6-7 times higher. A + group must be opened then closed for the agentview to be + updated using the new format." + :version "22.1" + :group 'gnus-agent + :type '(radio (const :format "Compressed" 2) + (const :format "Uncompressed" 1))) + ;;; Internal variables (defvar gnus-agent-history-buffers nil) @@ -839,7 +850,7 @@ be a select method." (save-excursion (dolist (gnus-command-method (gnus-agent-covered-methods)) (when (and (file-exists-p (gnus-agent-lib-file "flags")) - (not (eq (gnus-server-status gnus-command-method) 'offline))) + (eq (gnus-server-status gnus-command-method) 'ok)) (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) (defun gnus-agent-synchronize-flags-server (method) @@ -1871,7 +1882,7 @@ article numbers will be returned." (defsubst gnus-agent-read-article-number () "Reads the article number at point. Returns nil when a valid article number can not be read." - ;; It is unfortunite but the read function quietly overflows + ;; It is unfortunate but the read function quietly overflows ;; integer. As a result, I have to use string operations to test ;; for overflow BEFORE calling read. (when (looking-at "[0-9]+\t") @@ -1930,21 +1941,21 @@ doesn't exist, to valid the overview buffer." (gnus-agent-copy-nov-line (pop articles)) (ignore-errors - (while articles - (while (let ((art (read (current-buffer)))) - (cond ((< art (car articles)) - (forward-line 1) - t) - ((= art (car articles)) - (beginning-of-line) - (delete-region - (point) (progn (forward-line 1) (point))) - nil) - (t - (beginning-of-line) - nil)))) - - (gnus-agent-copy-nov-line (pop articles))))) + (while articles + (while (let ((art (read (current-buffer)))) + (cond ((< art (car articles)) + (forward-line 1) + t) + ((= art (car articles)) + (beginning-of-line) + (delete-region + (point) (progn (forward-line 1) (point))) + nil) + (t + (beginning-of-line) + nil)))) + + (gnus-agent-copy-nov-line (pop articles))))) (goto-char (point-max)) @@ -1960,23 +1971,39 @@ doesn't exist, to valid the overview buffer." (goto-char p)) (setq last (or last -134217728)) - (let (sort art) - (while (not (eobp)) - (setq art (gnus-agent-read-article-number)) - (cond ((not art) - ;; Bad art num - delete this line - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ((< art last) - ;; Art num out of order - enable sort - (setq sort t) - (forward-line 1)) - (t - ;; Good art num - (setq last art) - (forward-line 1)))) - (when sort - (sort-numeric-fields 1 (point-min) (point-max))))))) + (while (catch 'problems + (let (sort art) + (while (not (eobp)) + (setq art (gnus-agent-read-article-number)) + (cond ((not art) + ;; Bad art num - delete this line + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ((< art last) + ;; Art num out of order - enable sort + (setq sort t) + (forward-line 1)) + ((= art last) + ;; Bad repeat of art number - delete this line + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + (t + ;; Good art num + (setq last art) + (forward-line 1)))) + (when sort + ;; something is seriously wrong as we simply shouldn't see out-of-order data. + ;; First, we'll fix the sort. + (sort-numeric-fields 1 (point-min) (point-max)) + + ;; but now we have to consider that we may have duplicate rows... + ;; so reset to beginning of file + (goto-char (point-min)) + (setq last -134217728) + + ;; and throw a code that restarts this scan + (throw 'problems t)) + nil)))))) ;; Keeps the compiler from warning about the free variable in ;; gnus-agent-read-agentview. @@ -1993,61 +2020,55 @@ doesn't exist, to valid the overview buffer." 'gnus-agent-file-loading-cache 'gnus-agent-read-agentview)))) -;; Save format may be either 1 or 2. Two is the new, compressed -;; format that is still being tested. Format 1 is uncompressed but -;; known to be reliable. -(defconst gnus-agent-article-alist-save-format 2) - (defun gnus-agent-read-agentview (file) "Load FILE and do a `read' there." (with-temp-buffer (condition-case nil - (progn - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (let ((alist (read (current-buffer))) - (version (condition-case nil (read (current-buffer)) - (end-of-file 0))) - changed-version) - - (cond - ((< version 2) - (error "gnus-agent-read-agentview no longer supports version %d. Stop gnus, manually evaluate gnus-agent-convert-to-compressed-agentview, then restart gnus." version)) - ((= version 0) - (let ((inhibit-quit t) - entry) - (gnus-agent-open-history) - (set-buffer (gnus-agent-history-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (if (and (looking-at - "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") - (string= (match-string 2) - gnus-agent-read-agentview) - (setq entry (assoc (string-to-number (match-string 3)) alist))) - (setcdr entry (string-to-number (match-string 1)))) - (forward-line 1)) - (gnus-agent-close-history) - (setq changed-version t))) - ((= version 1) - (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) - ((= version 2) - (let (uncomp) - (mapcar - (lambda (comp-list) - (let ((state (car comp-list)) - (sequence (inline - (gnus-uncompress-range - (cdr comp-list))))) - (mapcar (lambda (article-id) - (setq uncomp (cons (cons article-id state) uncomp))) - sequence))) - alist) - (setq alist (sort uncomp 'car-less-than-car))))) - (when changed-version - (let ((gnus-agent-article-alist alist)) - (gnus-agent-save-alist gnus-agent-read-agentview))) - alist)) + (progn + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (let ((alist (read (current-buffer))) + (version (condition-case nil (read (current-buffer)) + (end-of-file 0))) + changed-version) + + (cond + ((= version 0) + (let ((inhibit-quit t) + entry) + (gnus-agent-open-history) + (set-buffer (gnus-agent-history-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (if (and (looking-at + "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)") + (string= (match-string 2) + gnus-agent-read-agentview) + (setq entry (assoc (string-to-number (match-string 3)) alist))) + (setcdr entry (string-to-number (match-string 1)))) + (forward-line 1)) + (gnus-agent-close-history) + (setq changed-version t))) + ((= version 1) + (setq changed-version (not (= 1 gnus-agent-article-alist-save-format)))) + ((= version 2) + (let (uncomp) + (mapcar + (lambda (comp-list) + (let ((state (car comp-list)) + (sequence (inline + (gnus-uncompress-range + (cdr comp-list))))) + (mapcar (lambda (article-id) + (setq uncomp (cons (cons article-id state) uncomp))) + sequence))) + alist) + (setq alist (sort uncomp 'car-less-than-car))) + (setq changed-version (not (= 2 gnus-agent-article-alist-save-format))))) + (when changed-version + (let ((gnus-agent-article-alist alist)) + (gnus-agent-save-alist gnus-agent-read-agentview))) + alist)) (file-error nil)))) (defun gnus-agent-save-alist (group &optional articles state) @@ -2159,7 +2180,7 @@ modified) original contents, they are first saved to their own file." ;; NOTE: The '+ 0' ensure that min and max are both numerics. (set group (cons (+ 0 min) (+ 0 max)))) (error - (gnus-message 3 "Warning - invalid agent local: %s on line %d: " + (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s" file line (error-message-string err)))) (forward-line 1) (setq line (1+ line)))) @@ -2190,13 +2211,14 @@ modified) original contents, they are first saved to their own file." ((member (symbol-name symbol) '("+dirty" "+method")) nil) (t - (prin1 symbol) (let ((range (symbol-value symbol))) - (princ " ") - (princ (car range)) - (princ " ") - (princ (cdr range)) - (princ "\n"))))) + (when range + (prin1 symbol) + (princ " ") + (princ (car range)) + (princ " ") + (princ (cdr range)) + (princ "\n")))))) my-obarray)))))))) (defun gnus-agent-get-local (group &optional gmane method) @@ -2987,7 +3009,7 @@ FORCE is equivalent to setting the expiration predicates to true." (if (or (not (eq articles t)) (yes-or-no-p (concat "Are you sure that you want to " - "expire all articles in " group "."))) + "expire all articles in " group "? "))) (let ((gnus-command-method (gnus-find-method-for-group group)) (overview (gnus-get-buffer-create " *expire overview*")) orig) @@ -3395,7 +3417,7 @@ FORCE is equivalent to setting the expiration predicates to true." (gnus-agent-expire-group group articles force) (if (or (not (eq articles t)) (yes-or-no-p "Are you sure that you want to expire all \ -articles in every agentized group.")) +articles in every agentized group? ")) (let ((methods (gnus-agent-covered-methods)) ;; Bind gnus-agent-expire-current-dirs to enable tracking ;; of agent directories.