Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnml.el @ 26:441bb1e64a06 r19-15b96

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b96
author cvs
date Mon, 13 Aug 2007 08:51:32 +0200
parents 4103f0995bd7
children 1917ad0d78d7
comparison
equal deleted inserted replaced
25:383a494979f8 26:441bb1e64a06
99 (number (length sequence)) 99 (number (length sequence))
100 (count 0) 100 (count 0)
101 beg article) 101 beg article)
102 (if (stringp (car sequence)) 102 (if (stringp (car sequence))
103 'headers 103 'headers
104 (unless nnml-article-file-alist
105 (setq nnml-article-file-alist
106 (nnheader-article-to-file-alist nnml-current-directory)))
107 (if (nnml-retrieve-headers-with-nov sequence fetch-old) 104 (if (nnml-retrieve-headers-with-nov sequence fetch-old)
108 'nov 105 'nov
109 (while sequence 106 (while sequence
110 (setq article (car sequence)) 107 (setq article (car sequence))
111 (setq file 108 (setq file (nnml-article-to-file article))
112 (concat nnml-current-directory
113 (or (cdr (assq article nnml-article-file-alist))
114 "")))
115 (when (and (file-exists-p file) 109 (when (and (file-exists-p file)
116 (not (file-directory-p file))) 110 (not (file-directory-p file)))
117 (insert (format "221 %d Article retrieved.\n" article)) 111 (insert (format "221 %d Article retrieved.\n" article))
118 (setq beg (point)) 112 (setq beg (point))
119 (nnheader-insert-head file) 113 (nnheader-insert-head file)
259 (nnheader-directory-articles nnml-current-directory)) 253 (nnheader-directory-articles nnml-current-directory))
260 (is-old t) 254 (is-old t)
261 article rest mod-time number) 255 article rest mod-time number)
262 (nnmail-activate 'nnml) 256 (nnmail-activate 'nnml)
263 257
264 (unless nnml-article-file-alist
265 (setq nnml-article-file-alist
266 (nnheader-article-to-file-alist nnml-current-directory)))
267
268 (while (and articles is-old) 258 (while (and articles is-old)
269 (when (setq article 259 (when (setq article (nnml-article-to-file (setq number (pop articles))))
270 (assq (setq number (pop articles))
271 nnml-article-file-alist))
272 (setq article (concat nnml-current-directory (cdr article)))
273 (when (setq mod-time (nth 5 (file-attributes article))) 260 (when (setq mod-time (nth 5 (file-attributes article)))
274 (if (and (nnml-deletable-article-p group number) 261 (if (and (nnml-deletable-article-p group number)
275 (setq is-old 262 (setq is-old
276 (nnmail-expired-article-p group mod-time force 263 (nnmail-expired-article-p group mod-time force
277 nnml-inhibit-expiry))) 264 nnml-inhibit-expiry)))
297 (deffoo nnml-request-move-article 284 (deffoo nnml-request-move-article
298 (article group server accept-form &optional last) 285 (article group server accept-form &optional last)
299 (let ((buf (get-buffer-create " *nnml move*")) 286 (let ((buf (get-buffer-create " *nnml move*"))
300 result) 287 result)
301 (nnml-possibly-change-directory group server) 288 (nnml-possibly-change-directory group server)
302 (unless nnml-article-file-alist 289 (nnml-update-file-alist)
303 (setq nnml-article-file-alist
304 (nnheader-article-to-file-alist nnml-current-directory)))
305 (and 290 (and
306 (nnml-deletable-article-p group article) 291 (nnml-deletable-article-p group article)
307 (nnml-request-article article group server) 292 (nnml-request-article article group server)
308 (save-excursion 293 (save-excursion
309 (set-buffer buf) 294 (set-buffer buf)
313 result) 298 result)
314 (progn 299 (progn
315 (nnml-possibly-change-directory group server) 300 (nnml-possibly-change-directory group server)
316 (condition-case () 301 (condition-case ()
317 (funcall nnmail-delete-file-function 302 (funcall nnmail-delete-file-function
318 (concat nnml-current-directory 303 (nnml-article-to-file article))
319 (int-to-string article)))
320 (file-error nil)) 304 (file-error nil))
321 (nnml-nov-delete-article group article) 305 (nnml-nov-delete-article group article)
322 (when last 306 (when last
323 (nnml-save-nov) 307 (nnml-save-nov)
324 (nnmail-save-active nnml-group-alist nnml-active-file)))) 308 (nnmail-save-active nnml-group-alist nnml-active-file))))
355 headers) 339 headers)
356 (when (condition-case () 340 (when (condition-case ()
357 (progn 341 (progn
358 (nnmail-write-region 342 (nnmail-write-region
359 (point-min) (point-max) 343 (point-min) (point-max)
360 (concat nnml-current-directory 344 (or (nnml-article-to-file article)
361 (int-to-string article)) 345 (concat nnml-current-directory
346 (int-to-string article)))
362 nil (if (nnheader-be-verbose 5) nil 'nomesg)) 347 nil (if (nnheader-be-verbose 5) nil 'nomesg))
363 t) 348 t)
364 (error nil)) 349 (error nil))
365 (setq headers (nnml-parse-head chars article)) 350 (setq headers (nnml-parse-head chars article))
366 ;; Replace the NOV line in the NOV file. 351 ;; Replace the NOV line in the NOV file.
464 449
465 450
466 ;;; Internal functions. 451 ;;; Internal functions.
467 452
468 (defun nnml-article-to-file (article) 453 (defun nnml-article-to-file (article)
469 (unless nnml-article-file-alist 454 (nnml-update-file-alist)
470 (setq nnml-article-file-alist
471 (nnheader-article-to-file-alist nnml-current-directory)))
472 (let (file) 455 (let (file)
473 (when (setq file (cdr (assq article nnml-article-file-alist))) 456 (when (setq file (cdr (assq article nnml-article-file-alist)))
474 (concat nnml-current-directory file)))) 457 (concat nnml-current-directory file))))
475 458
476 (defun nnml-deletable-article-p (group article) 459 (defun nnml-deletable-article-p (group article)
477 "Say whether ARTICLE in GROUP can be deleted." 460 "Say whether ARTICLE in GROUP can be deleted."
478 (let (file path) 461 (let (path)
479 (when (setq file (cdr (assq article nnml-article-file-alist))) 462 (when (setq path (nnml-article-to-file article))
480 (setq path (concat nnml-current-directory file))
481 (when (file-writable-p path) 463 (when (file-writable-p path)
482 (or (not nnmail-keep-last-article) 464 (or (not nnmail-keep-last-article)
483 (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) 465 (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
484 article))))))) 466 article)))))))
485 467
788 (when (and (setq num (ignore-errors (read (current-buffer)))) 770 (when (and (setq num (ignore-errors (read (current-buffer))))
789 (numberp num)) 771 (numberp num))
790 (setf (car active) num))))))) 772 (setf (car active) num)))))))
791 t)) 773 t))
792 774
775 (defun nnml-update-file-alist ()
776 (unless nnml-article-file-alist
777 (setq nnml-article-file-alist
778 (nnheader-article-to-file-alist nnml-current-directory))))
779
793 (provide 'nnml) 780 (provide 'nnml)
794 781
795 ;;; nnml.el ends here 782 ;;; nnml.el ends here