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) |
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 |
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) |
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) |
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. |
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) |
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 |
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") |
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)) |
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. |
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 |
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) |
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))) |
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)))) |
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) |
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) |
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 |
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) |
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))) |