/[emacs]/emacs/lisp/gnus/gnus-agent.el
ViewVC logotype

Diff of /emacs/lisp/gnus/gnus-agent.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.23 by miles, Sun Sep 25 21:26:32 2005 UTC revision 1.24 by miles, Fri Dec 9 08:57:57 2005 UTC
# Line 213  unplugged." Line 213  unplugged."
213    :group 'gnus-agent    :group 'gnus-agent
214    :type 'boolean)    :type 'boolean)
215    
216    (defcustom gnus-agent-article-alist-save-format 1
217      "Indicates whether to use compression(2), verses no
218      compression(1), when writing agentview files.  The compressed
219      files do save space but load times are 6-7 times higher.  A
220      group must be opened then closed for the agentview to be
221      updated using the new format."
222      :version "22.1"
223      :group 'gnus-agent
224      :type '(radio (const :format "Compressed" 2)
225                    (const :format "Uncompressed" 1)))
226    
227  ;;; Internal variables  ;;; Internal variables
228    
229  (defvar gnus-agent-history-buffers nil)  (defvar gnus-agent-history-buffers nil)
# Line 357  manipulated as follows: Line 368  manipulated as follows:
368  (gnus-agent-cat-defaccessor  (gnus-agent-cat-defaccessor
369   gnus-agent-cat-high-score                 agent-high-score)   gnus-agent-cat-high-score                 agent-high-score)
370  (gnus-agent-cat-defaccessor  (gnus-agent-cat-defaccessor
371   gnus-agent-cat-length-when-long           agent-length-when-long)   gnus-agent-cat-length-when-long           agent-long-article)
372  (gnus-agent-cat-defaccessor  (gnus-agent-cat-defaccessor
373   gnus-agent-cat-length-when-short          agent-length-when-short)   gnus-agent-cat-length-when-short          agent-short-article)
374  (gnus-agent-cat-defaccessor  (gnus-agent-cat-defaccessor
375   gnus-agent-cat-low-score                  agent-low-score)   gnus-agent-cat-low-score                  agent-low-score)
376  (gnus-agent-cat-defaccessor  (gnus-agent-cat-defaccessor
377   gnus-agent-cat-predicate                  agent-predicate)   gnus-agent-cat-predicate                  agent-predicate)
378  (gnus-agent-cat-defaccessor  (gnus-agent-cat-defaccessor
379   gnus-agent-cat-score-file                 agent-score-file)   gnus-agent-cat-score-file                 agent-score)
380  (gnus-agent-cat-defaccessor  (gnus-agent-cat-defaccessor
381   gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)   gnus-agent-cat-enable-undownloaded-faces  agent-enable-undownloaded-faces)
382    
383    
384  ;; This form is equivalent to defsetf except that it calls make-symbol  ;; This form is equivalent to defsetf except that it calls make-symbol
# Line 858  be a select method." Line 869  be a select method."
869    
870  ;;;###autoload  ;;;###autoload
871  (defun gnus-agent-rename-group (old-group new-group)  (defun gnus-agent-rename-group (old-group new-group)
872    "Rename fully-qualified OLD-GROUP as NEW-GROUP.  Always updates the agent, even when    "Rename fully-qualified OLD-GROUP as NEW-GROUP.
873  disabled, as the old agent files would corrupt gnus when the agent was  Always updates the agent, even when disabled, as the old agent
874  next enabled. Depends upon the caller to determine whether group renaming is supported."  files would corrupt gnus when the agent was next enabled.
875    Depends upon the caller to determine whether group renaming is
876    supported."
877    (let* ((old-command-method (gnus-find-method-for-group old-group))    (let* ((old-command-method (gnus-find-method-for-group old-group))
878           (old-path           (directory-file-name           (old-path           (directory-file-name
879                                (let (gnus-command-method old-command-method)                                (let (gnus-command-method old-command-method)
# Line 888  next enabled. Depends upon the caller to Line 901  next enabled. Depends upon the caller to
901    
902  ;;;###autoload  ;;;###autoload
903  (defun gnus-agent-delete-group (group)  (defun gnus-agent-delete-group (group)
904    "Delete fully-qualified GROUP.  Always updates the agent, even when    "Delete fully-qualified GROUP.
905  disabled, as the old agent files would corrupt gnus when the agent was  Always updates the agent, even when disabled, as the old agent
906  next enabled. Depends upon the caller to determine whether group deletion is supported."  files would corrupt gnus when the agent was next enabled.
907    Depends upon the caller to determine whether group deletion is
908    supported."
909    (let* ((command-method (gnus-find-method-for-group group))    (let* ((command-method (gnus-find-method-for-group group))
910           (path           (directory-file-name           (path           (directory-file-name
911                            (let (gnus-command-method command-method)                            (let (gnus-command-method command-method)
# Line 1134  downloadable." Line 1149  downloadable."
1149    (when gnus-newsgroup-processable    (when gnus-newsgroup-processable
1150      (setq gnus-newsgroup-downloadable      (setq gnus-newsgroup-downloadable
1151            (let* ((dl gnus-newsgroup-downloadable)            (let* ((dl gnus-newsgroup-downloadable)
1152                   (gnus-newsgroup-downloadable                   (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
1153                    (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))                   (gnus-newsgroup-downloadable processable))
1154                   (fetched-articles (gnus-agent-summary-fetch-group)))              (gnus-agent-summary-fetch-group)
1155              ;; The preceeding call to (gnus-agent-summary-fetch-group)  
1156              ;; updated gnus-newsgroup-downloadable to remove each              ;; For each article that I processed that is no longer
1157              ;; article successfully fetched.              ;; undownloaded, remove its processable mark.
1158    
1159              ;; For each article that I processed, remove its              (mapc #'gnus-summary-remove-process-mark
1160              ;; processable mark IF the article is no longer                    (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
1161              ;; downloadable (i.e. it's already downloaded)  
1162              (dolist (article gnus-newsgroup-processable)              ;; The preceeding call to (gnus-agent-summary-fetch-group)
1163                (unless (memq article gnus-newsgroup-downloadable)              ;; updated the temporary gnus-newsgroup-downloadable to
1164                  (gnus-summary-remove-process-mark article)))              ;; remove each article successfully fetched.  Now, I
1165              (gnus-sorted-ndifference dl fetched-articles)))))              ;; update the real gnus-newsgroup-downloadable to only
1166                ;; include undownloaded articles.
1167                (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
1168    
1169  (defun gnus-agent-summary-fetch-group (&optional all)  (defun gnus-agent-summary-fetch-group (&optional all)
1170    "Fetch the downloadable articles in the group.    "Fetch the downloadable articles in the group.
# Line 1240  This can be added to `gnus-select-articl Line 1257  This can be added to `gnus-select-articl
1257                                    'gnus-range-add                                    'gnus-range-add
1258                                  'gnus-remove-from-range)                                  'gnus-remove-from-range)
1259                                (cdr info-marks)                                (cdr info-marks)
1260                                range)))))))))                                range))))))))
1261    
1262          ;;Marks can be synchronized at any time by simply toggling from
1263          ;;unplugged to plugged.  If that is what is happening right now, make
1264          ;;sure that the group buffer is up to date.
1265              (when (gnus-buffer-live-p gnus-group-buffer)
1266                (gnus-group-update-group group t)))
1267      nil))      nil))
1268    
1269  (defun gnus-agent-save-active (method)  (defun gnus-agent-save-active (method)
# Line 1330  downloaded into the agent." Line 1353  downloaded into the agent."
1353            (when (re-search-forward            (when (re-search-forward
1354                   (concat "^" (regexp-quote group) " ") nil t)                   (concat "^" (regexp-quote group) " ") nil t)
1355              (save-excursion              (save-excursion
1356                (setq oactive-max (read (current-buffer)) ;; max                (setq oactive-max (read (current-buffer)) ;; max
1357                      oactive-min (read (current-buffer)))) ;; min                      oactive-min (read (current-buffer)))) ;; min
1358              (gnus-delete-line)))              (gnus-delete-line)))
1359          (when active          (when active
# Line 1824  article numbers will be returned." Line 1847  article numbers will be returned."
1847  (defsubst gnus-agent-read-article-number ()  (defsubst gnus-agent-read-article-number ()
1848    "Reads the article number at point.  Returns nil when a valid article number can not be read."    "Reads the article number at point.  Returns nil when a valid article number can not be read."
1849    
1850    ;; It is unfortunite but the read function quietly overflows    ;; It is unfortunate but the read function quietly overflows
1851    ;; integer.  As a result, I have to use string operations to test    ;; integer.  As a result, I have to use string operations to test
1852    ;; for overflow BEFORE calling read.    ;; for overflow BEFORE calling read.
1853    (when (looking-at "[0-9]+\t")    (when (looking-at "[0-9]+\t")
# Line 1913  doesn't exist, to valid the overview buf Line 1936  doesn't exist, to valid the overview buf
1936          (goto-char p))          (goto-char p))
1937    
1938        (setq last (or last -134217728))        (setq last (or last -134217728))
1939          (while (catch 'problems
1940        (let (sort art)        (let (sort art)
1941          (while (not (eobp))          (while (not (eobp))
1942            (setq art (gnus-agent-read-article-number))            (setq art (gnus-agent-read-article-number))
# Line 1924  doesn't exist, to valid the overview buf Line 1948  doesn't exist, to valid the overview buf
1948                   ;; Art num out of order - enable sort                   ;; Art num out of order - enable sort
1949                   (setq sort t)                   (setq sort t)
1950                   (forward-line 1))                   (forward-line 1))
1951                             ((= art last)
1952                              ;; Bad repeat of art number - delete this line
1953                              (beginning-of-line)
1954                              (delete-region (point) (progn (forward-line 1) (point))))
1955                  (t                  (t
1956                   ;; Good art num                   ;; Good art num
1957                   (setq last art)                   (setq last art)
1958                   (forward-line 1))))                   (forward-line 1))))
1959          (when sort          (when sort
1960            (sort-numeric-fields 1 (point-min) (point-max)))))))                     ;; something is seriously wrong as we simply shouldn't see out-of-order data.
1961                       ;; First, we'll fix the sort.
1962                       (sort-numeric-fields 1 (point-min) (point-max))
1963    
1964                       ;; but now we have to consider that we may have duplicate rows...      
1965                       ;; so reset to beginning of file
1966                       (goto-char (point-min))
1967                       (setq last -134217728)
1968              
1969                       ;; and throw a code that restarts this scan
1970                       (throw 'problems t))
1971                     nil))))))
1972    
1973  ;; Keeps the compiler from warning about the free variable in  ;; Keeps the compiler from warning about the free variable in
1974  ;; gnus-agent-read-agentview.  ;; gnus-agent-read-agentview.
# Line 1946  doesn't exist, to valid the overview buf Line 1985  doesn't exist, to valid the overview buf
1985             'gnus-agent-file-loading-cache             'gnus-agent-file-loading-cache
1986             'gnus-agent-read-agentview))))             'gnus-agent-read-agentview))))
1987    
 ;; 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)  
   
1988  (defun gnus-agent-read-agentview (file)  (defun gnus-agent-read-agentview (file)
1989    "Load FILE and do a `read' there."    "Load FILE and do a `read' there."
1990    (with-temp-buffer    (with-temp-buffer
# Line 1964  doesn't exist, to valid the overview buf Line 1998  doesn't exist, to valid the overview buf
1998                changed-version)                changed-version)
1999    
2000            (cond            (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))  
2001             ((= version 0)             ((= version 0)
2002              (let ((inhibit-quit t)              (let ((inhibit-quit t)
2003                    entry)                    entry)
# Line 1996  doesn't exist, to valid the overview buf Line 2028  doesn't exist, to valid the overview buf
2028                               (setq uncomp (cons (cons article-id state) uncomp)))                               (setq uncomp (cons (cons article-id state) uncomp)))
2029                             sequence)))                             sequence)))
2030                 alist)                 alist)
2031                (setq alist (sort uncomp 'car-less-than-car)))))                  (setq alist (sort uncomp 'car-less-than-car)))
2032                  (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
2033            (when changed-version            (when changed-version
2034              (let ((gnus-agent-article-alist alist))              (let ((gnus-agent-article-alist alist))
2035                (gnus-agent-save-alist gnus-agent-read-agentview)))                (gnus-agent-save-alist gnus-agent-read-agentview)))
# Line 2110  modified) original contents, they are fi Line 2143  modified) original contents, they are fi
2143                ;; NOTE: The '+ 0' ensure that min and max are both numerics.                ;; NOTE: The '+ 0' ensure that min and max are both numerics.
2144                (set group (cons (+ 0 min) (+ 0 max))))                (set group (cons (+ 0 min) (+ 0 max))))
2145            (error            (error
2146             (gnus-message 3 "Warning - invalid agent local: %s on line %d: "             (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
2147                           file line (error-message-string err))))                           file line (error-message-string err))))
2148          (forward-line 1)          (forward-line 1)
2149          (setq line (1+ line))))          (setq line (1+ line))))
# Line 2141  modified) original contents, they are fi Line 2174  modified) original contents, they are fi
2174                                  ((member (symbol-name symbol) '("+dirty" "+method"))                                  ((member (symbol-name symbol) '("+dirty" "+method"))
2175                                   nil)                                   nil)
2176                                  (t                                  (t
                                  (prin1 symbol)  
2177                                   (let ((range (symbol-value symbol)))                                   (let ((range (symbol-value symbol)))
2178                                       (when range
2179                                     (prin1 symbol)
2180                                     (princ " ")                                     (princ " ")
2181                                     (princ (car range))                                     (princ (car range))
2182                                     (princ " ")                                     (princ " ")
2183                                     (princ (cdr range))                                     (princ (cdr range))
2184                                     (princ "\n")))))                                       (princ "\n"))))))
2185                          my-obarray))))))))                          my-obarray))))))))
2186    
2187  (defun gnus-agent-get-local (group &optional gmane method)  (defun gnus-agent-get-local (group &optional gmane method)
# Line 2402  modified) original contents, they are fi Line 2436  modified) original contents, they are fi
2436                          (dolist (article marked-articles)                          (dolist (article marked-articles)
2437                            (gnus-summary-set-agent-mark article t))                            (gnus-summary-set-agent-mark article t))
2438                          (dolist (article fetched-articles)                          (dolist (article fetched-articles)
2439                            (if gnus-agent-mark-unread-after-downloaded                            (when gnus-agent-mark-unread-after-downloaded
2440                                (setq gnus-newsgroup-downloadable
2441                                      (delq article gnus-newsgroup-downloadable))
2442                                (gnus-summary-mark-article                                (gnus-summary-mark-article
2443                                 article gnus-unread-mark))                                 article gnus-unread-mark))
2444                            (when (gnus-summary-goto-subject article nil t)                            (when (gnus-summary-goto-subject article nil t)
# Line 3191  missing NOV entry.  Run gnus-agent-regen Line 3227  missing NOV entry.  Run gnus-agent-regen
3227                 ((setq type                 ((setq type
3228                        (cond                        (cond
3229                         ((not (integerp fetch-date))                         ((not (integerp fetch-date))
3230                          'read) ;; never fetched article (may expire                           'read) ;; never fetched article (may expire
3231                         ;; right now)                         ;; right now)
3232                         ((not (file-exists-p                         ((not (file-exists-p
3233                                (concat dir (number-to-string                                (concat dir (number-to-string
# Line 3871  If REREAD is not nil, downloaded article Line 3907  If REREAD is not nil, downloaded article
3907                  (gnus-agent-possibly-alter-active group group-active)))))                  (gnus-agent-possibly-alter-active group group-active)))))
3908    
3909          (when (and reread gnus-agent-article-alist)          (when (and reread gnus-agent-article-alist)
3910            (gnus-make-ascending-articles-unread          (gnus-agent-synchronize-group-flags
3911             group             group
3912             (list (list
3913             (if (listp reread)             (if (listp reread)
3914                 reread                 reread
3915               (delq nil (mapcar (function (lambda (c)               (delq nil (mapcar (function (lambda (c)
# Line 3880  If REREAD is not nil, downloaded article Line 3917  If REREAD is not nil, downloaded article
3917                                                    (car c))                                                    (car c))
3918                                                   ((cdr c)                                                   ((cdr c)
3919                                                    (car c)))))                                                    (car c)))))
3920                                 gnus-agent-article-alist))))                                      gnus-agent-article-alist)))
3921                    'del '(read)))
3922             gnus-command-method)
3923    
3924            (when (gnus-buffer-live-p gnus-group-buffer)            (when (gnus-buffer-live-p gnus-group-buffer)
3925              (gnus-group-update-group group t)))              (gnus-group-update-group group t)))

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26