Mercurial > hg > xemacs-beta
comparison lisp/gnus/nnmh.el @ 16:0293115a14e9 r19-15b91
Import from CVS: tag r19-15b91
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:49:20 +0200 |
parents | ac2d302a0011 |
children | 4103f0995bd7 |
comparison
equal
deleted
inserted
replaced
15:ad457d5f7d04 | 16:0293115a14e9 |
---|---|
1 ;;; nnmh.el --- mhspool access for Gnus | 1 ;;; nnmh.el --- mhspool access for Gnus |
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc. | 2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. |
3 | 3 |
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> |
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | 5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
6 ;; Keywords: news, mail | 6 ;; Keywords: news, mail |
7 | 7 |
30 | 30 |
31 ;;; Code: | 31 ;;; Code: |
32 | 32 |
33 (require 'nnheader) | 33 (require 'nnheader) |
34 (require 'nnmail) | 34 (require 'nnmail) |
35 (require 'gnus) | 35 (require 'gnus-start) |
36 (require 'nnoo) | 36 (require 'nnoo) |
37 (eval-and-compile (require 'cl)) | 37 (require 'cl) |
38 | 38 |
39 (nnoo-declare nnmh) | 39 (nnoo-declare nnmh) |
40 | 40 |
41 (defvoo nnmh-directory message-directory | 41 (defvoo nnmh-directory message-directory |
42 "*Mail spool directory.") | 42 "*Mail spool directory.") |
103 (and large | 103 (and large |
104 (zerop (% count 20)) | 104 (zerop (% count 20)) |
105 (message "nnmh: Receiving headers... %d%%" | 105 (message "nnmh: Receiving headers... %d%%" |
106 (/ (* count 100) number)))) | 106 (/ (* count 100) number)))) |
107 | 107 |
108 (and large (message "nnmh: Receiving headers...done")) | 108 (when large |
109 (message "nnmh: Receiving headers...done")) | |
109 | 110 |
110 (nnheader-fold-continuation-lines) | 111 (nnheader-fold-continuation-lines) |
111 'headers)))) | 112 'headers)))) |
112 | 113 |
113 (deffoo nnmh-open-server (server &optional defs) | 114 (deffoo nnmh-open-server (server &optional defs) |
174 (t | 175 (t |
175 (nnheader-report 'nnmh "Empty group %s" group) | 176 (nnheader-report 'nnmh "Empty group %s" group) |
176 (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) | 177 (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) |
177 | 178 |
178 (deffoo nnmh-request-scan (&optional group server) | 179 (deffoo nnmh-request-scan (&optional group server) |
179 (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) | 180 (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) |
180 | 181 |
181 (deffoo nnmh-request-list (&optional server dir) | 182 (deffoo nnmh-request-list (&optional server dir) |
182 (nnheader-insert "") | 183 (nnheader-insert "") |
183 (let ((nnmh-toplev | 184 (let ((nnmh-toplev |
184 (or dir (file-truename (file-name-as-directory nnmh-directory))))) | 185 (or dir (file-truename (file-name-as-directory nnmh-directory))))) |
214 "%s %d %d y\n" | 215 "%s %d %d y\n" |
215 (progn | 216 (progn |
216 (string-match | 217 (string-match |
217 (regexp-quote | 218 (regexp-quote |
218 (file-truename (file-name-as-directory | 219 (file-truename (file-name-as-directory |
219 (expand-file-name nnmh-toplev)))) dir) | 220 (expand-file-name nnmh-toplev)))) |
221 dir) | |
220 (nnheader-replace-chars-in-string | 222 (nnheader-replace-chars-in-string |
221 (substring dir (match-end 0)) ?/ ?.)) | 223 (substring dir (match-end 0)) ?/ ?.)) |
222 (apply 'max files) | 224 (apply 'max files) |
223 (apply 'min files))))))) | 225 (apply 'min files))))))) |
224 t) | 226 t) |
225 | 227 |
226 (deffoo nnmh-request-newgroups (date &optional server) | 228 (deffoo nnmh-request-newgroups (date &optional server) |
227 (nnmh-request-list server)) | 229 (nnmh-request-list server)) |
239 (nnmail-activate 'nnmh) | 241 (nnmail-activate 'nnmh) |
240 | 242 |
241 (while (and articles is-old) | 243 (while (and articles is-old) |
242 (setq article (concat nnmh-current-directory | 244 (setq article (concat nnmh-current-directory |
243 (int-to-string (car articles)))) | 245 (int-to-string (car articles)))) |
244 (if (setq mod-time (nth 5 (file-attributes article))) | 246 (when (setq mod-time (nth 5 (file-attributes article))) |
245 (if (and (nnmh-deletable-article-p newsgroup (car articles)) | 247 (if (and (nnmh-deletable-article-p newsgroup (car articles)) |
246 (setq is-old | 248 (setq is-old |
247 (nnmail-expired-article-p newsgroup mod-time force))) | 249 (nnmail-expired-article-p newsgroup mod-time force))) |
248 (progn | 250 (progn |
249 (nnheader-message 5 "Deleting article %s in %s..." | 251 (nnheader-message 5 "Deleting article %s in %s..." |
250 article newsgroup) | 252 article newsgroup) |
251 (condition-case () | 253 (condition-case () |
252 (funcall nnmail-delete-file-function article) | 254 (funcall nnmail-delete-file-function article) |
253 (file-error | 255 (file-error |
254 (nnheader-message 1 "Couldn't delete article %s in %s" | 256 (nnheader-message 1 "Couldn't delete article %s in %s" |
255 article newsgroup) | 257 article newsgroup) |
256 (setq rest (cons (car articles) rest))))) | 258 (push (car articles) rest)))) |
257 (setq rest (cons (car articles) rest)))) | 259 (push (car articles) rest))) |
258 (setq articles (cdr articles))) | 260 (setq articles (cdr articles))) |
259 (message "") | 261 (message "") |
260 (nconc rest articles))) | 262 (nconc rest articles))) |
261 | 263 |
262 (deffoo nnmh-close-group (group &optional server) | 264 (deffoo nnmh-close-group (group &optional server) |
287 (nnmh-possibly-change-directory group server) | 289 (nnmh-possibly-change-directory group server) |
288 (nnmail-check-syntax) | 290 (nnmail-check-syntax) |
289 (if (stringp group) | 291 (if (stringp group) |
290 (and | 292 (and |
291 (nnmail-activate 'nnmh) | 293 (nnmail-activate 'nnmh) |
292 ;; We trick the choosing function into believing that only one | 294 (car (nnmh-save-mail |
293 ;; group is available. | 295 (list (cons group (nnmh-active-number group))) |
294 (let ((nnmail-split-methods (list (list group "")))) | 296 noinsert))) |
295 (car (nnmh-save-mail noinsert)))) | |
296 (and | 297 (and |
297 (nnmail-activate 'nnmh) | 298 (nnmail-activate 'nnmh) |
298 (car (nnmh-save-mail noinsert))))) | 299 (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) |
300 noinsert))))) | |
299 | 301 |
300 (deffoo nnmh-request-replace-article (article group buffer) | 302 (deffoo nnmh-request-replace-article (article group buffer) |
301 (nnmh-possibly-change-directory group) | 303 (nnmh-possibly-change-directory group) |
302 (save-excursion | 304 (save-excursion |
303 (set-buffer buffer) | 305 (set-buffer buffer) |
304 (nnmh-possibly-create-directory group) | 306 (nnmh-possibly-create-directory group) |
305 (condition-case () | 307 (ignore-errors |
306 (progn | 308 (nnmail-write-region |
307 (write-region | 309 (point-min) (point-max) |
308 (point-min) (point-max) | 310 (concat nnmh-current-directory (int-to-string article)) |
309 (concat nnmh-current-directory (int-to-string article)) | 311 nil (if (nnheader-be-verbose 5) nil 'nomesg)) |
310 nil (if (nnheader-be-verbose 5) nil 'nomesg)) | 312 t))) |
311 t) | 313 |
312 (error nil)))) | 314 (deffoo nnmh-request-create-group (group &optional server args) |
313 | |
314 (deffoo nnmh-request-create-group (group &optional server) | |
315 (nnmail-activate 'nnmh) | 315 (nnmail-activate 'nnmh) |
316 (or (assoc group nnmh-group-alist) | 316 (unless (assoc group nnmh-group-alist) |
317 (let (active) | 317 (let (active) |
318 (setq nnmh-group-alist (cons (list group (setq active (cons 1 0))) | 318 (push (list group (setq active (cons 1 0))) |
319 nnmh-group-alist)) | 319 nnmh-group-alist) |
320 (nnmh-possibly-create-directory group) | 320 (nnmh-possibly-create-directory group) |
321 (nnmh-possibly-change-directory group server) | 321 (nnmh-possibly-change-directory group server) |
322 (let ((articles (mapcar | 322 (let ((articles (mapcar |
323 (lambda (file) | 323 (lambda (file) |
324 (string-to-int file)) | 324 (string-to-int file)) |
325 (directory-files | 325 (directory-files |
326 nnmh-current-directory nil "^[0-9]+$")))) | 326 nnmh-current-directory nil "^[0-9]+$")))) |
327 (and articles | 327 (when articles |
328 (progn | 328 (setcar active (apply 'min articles)) |
329 (setcar active (apply 'min articles)) | 329 (setcdr active (apply 'max articles)))))) |
330 (setcdr active (apply 'max articles))))))) | |
331 t) | 330 t) |
332 | 331 |
333 (deffoo nnmh-request-delete-group (group &optional force server) | 332 (deffoo nnmh-request-delete-group (group &optional force server) |
334 (nnmh-possibly-change-directory group server) | 333 (nnmh-possibly-change-directory group server) |
335 ;; Delete all articles in GROUP. | 334 ;; Delete all articles in GROUP. |
336 (if (not force) | 335 (if (not force) |
337 () ; Don't delete the articles. | 336 () ; Don't delete the articles. |
338 (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) | 337 (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) |
339 (while articles | 338 (while articles |
340 (and (file-writable-p (car articles)) | 339 (when (file-writable-p (car articles)) |
341 (progn | 340 (nnheader-message 5 "Deleting article %s in %s..." |
342 (nnheader-message 5 "Deleting article %s in %s..." | 341 (car articles) group) |
343 (car articles) group) | 342 (funcall nnmail-delete-file-function (car articles))) |
344 (funcall nnmail-delete-file-function (car articles)))) | |
345 (setq articles (cdr articles)))) | 343 (setq articles (cdr articles)))) |
346 ;; Try to delete the directory itself. | 344 ;; Try to delete the directory itself. |
347 (condition-case () | 345 (ignore-errors |
348 (delete-directory nnmh-current-directory) | 346 (delete-directory nnmh-current-directory))) |
349 (error nil))) | |
350 ;; Remove the group from all structures. | 347 ;; Remove the group from all structures. |
351 (setq nnmh-group-alist | 348 (setq nnmh-group-alist |
352 (delq (assoc group nnmh-group-alist) nnmh-group-alist) | 349 (delq (assoc group nnmh-group-alist) nnmh-group-alist) |
353 nnmh-current-directory nil) | 350 nnmh-current-directory nil) |
354 t) | 351 t) |
355 | 352 |
356 (deffoo nnmh-request-rename-group (group new-name &optional server) | 353 (deffoo nnmh-request-rename-group (group new-name &optional server) |
357 (nnmh-possibly-change-directory group server) | 354 (nnmh-possibly-change-directory group server) |
358 ;; Rename directory. | 355 (let ((new-dir (nnmail-group-pathname new-name nnmh-directory)) |
359 (and (file-writable-p nnmh-current-directory) | 356 (old-dir (nnmail-group-pathname group nnmh-directory))) |
360 (condition-case () | 357 (when (ignore-errors |
361 (progn | 358 (make-directory new-dir t) |
362 (rename-file | 359 t) |
363 (directory-file-name nnmh-current-directory) | 360 ;; We move the articles file by file instead of renaming |
364 (directory-file-name | 361 ;; the directory -- there may be subgroups in this group. |
365 (nnmail-group-pathname new-name nnmh-directory))) | 362 ;; One might be more clever, I guess. |
366 t) | 363 (let ((files (nnheader-article-to-file-alist old-dir))) |
367 (error nil)) | 364 (while files |
368 ;; That went ok, so we change the internal structures. | 365 (rename-file |
369 (let ((entry (assoc group nnmh-group-alist))) | 366 (concat old-dir (cdar files)) |
370 (and entry (setcar entry new-name)) | 367 (concat new-dir (cdar files))) |
371 (setq nnmh-current-directory nil) | 368 (pop files))) |
372 t))) | 369 (when (<= (length (directory-files old-dir)) 2) |
370 (ignore-errors | |
371 (delete-directory old-dir))) | |
372 ;; That went ok, so we change the internal structures. | |
373 (let ((entry (assoc group nnmh-group-alist))) | |
374 (when entry | |
375 (setcar entry new-name)) | |
376 (setq nnmh-current-directory nil) | |
377 t)))) | |
378 | |
379 (nnoo-define-skeleton nnmh) | |
373 | 380 |
374 | 381 |
375 ;;; Internal functions. | 382 ;;; Internal functions. |
376 | 383 |
377 (defun nnmh-possibly-change-directory (newsgroup &optional server) | 384 (defun nnmh-possibly-change-directory (newsgroup &optional server) |
378 (when (and server | 385 (when (and server |
379 (not (nnmh-server-opened server))) | 386 (not (nnmh-server-opened server))) |
380 (nnmh-open-server server)) | 387 (nnmh-open-server server)) |
381 (if newsgroup | 388 (when newsgroup |
382 (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) | 389 (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) |
383 (if (file-directory-p pathname) | 390 (if (file-directory-p pathname) |
384 (setq nnmh-current-directory pathname) | 391 (setq nnmh-current-directory pathname) |
385 (error "No such newsgroup: %s" newsgroup))))) | 392 (error "No such newsgroup: %s" newsgroup))))) |
386 | 393 |
387 (defun nnmh-possibly-create-directory (group) | 394 (defun nnmh-possibly-create-directory (group) |
388 (let (dir dirs) | 395 (let (dir dirs) |
389 (setq dir (nnmail-group-pathname group nnmh-directory)) | 396 (setq dir (nnmail-group-pathname group nnmh-directory)) |
390 (while (not (file-directory-p dir)) | 397 (while (not (file-directory-p dir)) |
391 (setq dirs (cons dir dirs)) | 398 (push dir dirs) |
392 (setq dir (file-name-directory (directory-file-name dir)))) | 399 (setq dir (file-name-directory (directory-file-name dir)))) |
393 (while dirs | 400 (while dirs |
394 (if (make-directory (directory-file-name (car dirs))) | 401 (when (make-directory (directory-file-name (car dirs))) |
395 (error "Could not create directory %s" (car dirs))) | 402 (error "Could not create directory %s" (car dirs))) |
396 (nnheader-message 5 "Creating mail directory %s" (car dirs)) | 403 (nnheader-message 5 "Creating mail directory %s" (car dirs)) |
397 (setq dirs (cdr dirs))))) | 404 (setq dirs (cdr dirs))))) |
398 | 405 |
399 (defun nnmh-save-mail (&optional noinsert) | 406 (defun nnmh-save-mail (group-art &optional noinsert) |
400 "Called narrowed to an article." | 407 "Called narrowed to an article." |
401 (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))) | 408 (unless noinsert |
402 (unless noinsert | 409 (nnmail-insert-lines) |
403 (nnmail-insert-lines) | 410 (nnmail-insert-xref group-art)) |
404 (nnmail-insert-xref group-art)) | 411 (run-hooks 'nnmail-prepare-save-mail-hook) |
405 (run-hooks 'nnmail-prepare-save-mail-hook) | 412 (run-hooks 'nnmh-prepare-save-mail-hook) |
406 (run-hooks 'nnmh-prepare-save-mail-hook) | 413 (goto-char (point-min)) |
407 (goto-char (point-min)) | 414 (while (looking-at "From ") |
408 (while (looking-at "From ") | 415 (replace-match "X-From-Line: ") |
409 (replace-match "X-From-Line: ") | 416 (forward-line 1)) |
410 (forward-line 1)) | 417 ;; We save the article in all the newsgroups it belongs in. |
411 ;; We save the article in all the newsgroups it belongs in. | 418 (let ((ga group-art) |
412 (let ((ga group-art) | 419 first) |
413 first) | 420 (while ga |
414 (while ga | 421 (nnmh-possibly-create-directory (caar ga)) |
415 (nnmh-possibly-create-directory (caar ga)) | 422 (let ((file (concat (nnmail-group-pathname |
416 (let ((file (concat (nnmail-group-pathname | 423 (caar ga) nnmh-directory) |
417 (caar ga) nnmh-directory) | 424 (int-to-string (cdar ga))))) |
418 (int-to-string (cdar ga))))) | 425 (if first |
419 (if first | 426 ;; It was already saved, so we just make a hard link. |
420 ;; It was already saved, so we just make a hard link. | 427 (funcall nnmail-crosspost-link-function first file t) |
421 (funcall nnmail-crosspost-link-function first file t) | 428 ;; Save the article. |
422 ;; Save the article. | 429 (nnmail-write-region (point-min) (point-max) file nil nil) |
423 (write-region (point-min) (point-max) file nil nil) | 430 (setq first file))) |
424 (setq first file))) | 431 (setq ga (cdr ga)))) |
425 (setq ga (cdr ga)))) | 432 group-art) |
426 group-art)) | |
427 | 433 |
428 (defun nnmh-active-number (group) | 434 (defun nnmh-active-number (group) |
429 "Compute the next article number in GROUP." | 435 "Compute the next article number in GROUP." |
430 (let ((active (cadr (assoc group nnmh-group-alist)))) | 436 (let ((active (cadr (assoc group nnmh-group-alist)))) |
431 ;; The group wasn't known to nnmh, so we just create an active | 437 (unless active |
432 ;; entry for it. | 438 ;; The group wasn't known to nnmh, so we just create an active |
433 (or active | 439 ;; entry for it. |
434 (progn | 440 (setq active (cons 1 0)) |
435 (setq active (cons 1 0)) | 441 (push (list group active) nnmh-group-alist) |
436 (setq nnmh-group-alist (cons (list group active) nnmh-group-alist)))) | 442 ;; Find the highest number in the group. |
443 (let ((files (sort | |
444 (mapcar | |
445 (lambda (f) | |
446 (string-to-int f)) | |
447 (directory-files | |
448 (nnmail-group-pathname group nnmh-directory) | |
449 nil "^[0-9]+$")) | |
450 '>))) | |
451 (when files | |
452 (setcdr active (car files))))) | |
437 (setcdr active (1+ (cdr active))) | 453 (setcdr active (1+ (cdr active))) |
438 (while (file-exists-p | 454 (while (file-exists-p |
439 (concat (nnmail-group-pathname group nnmh-directory) | 455 (concat (nnmail-group-pathname group nnmh-directory) |
440 (int-to-string (cdr active)))) | 456 (int-to-string (cdr active)))) |
441 (setcdr active (1+ (cdr active)))) | 457 (setcdr active (1+ (cdr active)))) |
442 (cdr active))) | 458 (cdr active))) |
443 | 459 |
444 (defun nnmh-update-gnus-unreads (group) | 460 (defun nnmh-update-gnus-unreads (group) |
445 ;; Go through the .nnmh-articles file and compare with the actual | 461 ;; Go through the .nnmh-articles file and compare with the actual |
446 ;; articles in this folder. The articles that are "new" will be | 462 ;; articles in this folder. The articles that are "new" will be |
447 ;; marked as unread by Gnus. | 463 ;; marked as unread by Gnus. |
448 (let* ((dir nnmh-current-directory) | 464 (let* ((dir nnmh-current-directory) |
449 (files (sort (mapcar (function (lambda (name) (string-to-int name))) | 465 (files (sort (mapcar (function (lambda (name) (string-to-int name))) |
450 (directory-files nnmh-current-directory | 466 (directory-files nnmh-current-directory |
451 nil "^[0-9]+$" t)) '<)) | 467 nil "^[0-9]+$" t)) |
468 '<)) | |
452 (nnmh-file (concat dir ".nnmh-articles")) | 469 (nnmh-file (concat dir ".nnmh-articles")) |
453 new articles) | 470 new articles) |
454 ;; Load the .nnmh-articles file. | 471 ;; Load the .nnmh-articles file. |
455 (if (file-exists-p nnmh-file) | 472 (when (file-exists-p nnmh-file) |
456 (setq articles | 473 (setq articles |
457 (let (nnmh-newsgroup-articles) | 474 (let (nnmh-newsgroup-articles) |
458 (condition-case nil (load nnmh-file nil t t) (error nil)) | 475 (ignore-errors (load nnmh-file nil t t)) |
459 nnmh-newsgroup-articles))) | 476 nnmh-newsgroup-articles))) |
460 ;; Add all new articles to the `new' list. | 477 ;; Add all new articles to the `new' list. |
461 (let ((art files)) | 478 (let ((art files)) |
462 (while art | 479 (while art |
463 (if (not (assq (car art) articles)) (setq new (cons (car art) new))) | 480 (unless (assq (car art) articles) |
481 (push (car art) new)) | |
464 (setq art (cdr art)))) | 482 (setq art (cdr art)))) |
465 ;; Remove all deleted articles. | 483 ;; Remove all deleted articles. |
466 (let ((art articles)) | 484 (let ((art articles)) |
467 (while art | 485 (while art |
468 (if (not (memq (caar art) files)) | 486 (unless (memq (caar art) files) |
469 (setq articles (delq (car art) articles))) | 487 (setq articles (delq (car art) articles))) |
470 (setq art (cdr art)))) | 488 (setq art (cdr art)))) |
471 ;; Check whether the highest-numbered articles really are the ones | 489 ;; Check whether the articles really are the ones that Gnus thinks |
472 ;; that Gnus thinks they are by looking at the time-stamps. | 490 ;; they are by looking at the time-stamps. |
473 (let ((art articles)) | 491 (let ((arts articles) |
474 (while (and art | 492 art) |
475 (not (equal | 493 (while (setq art (pop arts)) |
476 (nth 5 (file-attributes | 494 (when (not (equal |
477 (concat dir (int-to-string (caar art))))) | 495 (nth 5 (file-attributes |
478 (cdar art)))) | 496 (concat dir (int-to-string (car art))))) |
479 (setq articles (delq (car art) articles)) | 497 (cdr art))) |
480 (setq new (cons (caar art) new)) | 498 (setq articles (delq art articles)) |
481 (setq art (cdr art)))) | 499 (push (car art) new)))) |
482 ;; Go through all the new articles and add them, and their | 500 ;; Go through all the new articles and add them, and their |
483 ;; time-stamps to the list. | 501 ;; time-stamps, to the list. |
484 (let ((n new)) | 502 (setq articles |
485 (while n | 503 (nconc articles |
486 (setq articles | 504 (mapcar |
487 (cons (cons | 505 (lambda (art) |
488 (car n) | 506 (cons art |
489 (nth 5 (file-attributes | 507 (nth 5 (file-attributes |
490 (concat dir (int-to-string (car n)))))) | 508 (concat dir (int-to-string art)))))) |
491 articles)) | 509 new))) |
492 (setq n (cdr n)))) | |
493 ;; Make Gnus mark all new articles as unread. | 510 ;; Make Gnus mark all new articles as unread. |
494 (or (zerop (length new)) | 511 (when new |
495 (gnus-make-articles-unread | 512 (gnus-make-articles-unread |
496 (gnus-group-prefixed-name group (list 'nnmh "")) | 513 (gnus-group-prefixed-name group (list 'nnmh "")) |
497 (setq new (sort new '<)))) | 514 (setq new (sort new '<)))) |
498 ;; Sort the article list with highest numbers first. | 515 ;; Sort the article list with highest numbers first. |
499 (setq articles (sort articles (lambda (art1 art2) | 516 (setq articles (sort articles (lambda (art1 art2) |
500 (> (car art1) (car art2))))) | 517 (> (car art1) (car art2))))) |
501 ;; Finally write this list back to the .nnmh-articles file. | 518 ;; Finally write this list back to the .nnmh-articles file. |
502 (save-excursion | 519 (nnheader-temp-write nnmh-file |
503 (set-buffer (get-buffer-create "*nnmh out*")) | |
504 (insert ";; Gnus article active file for " group "\n\n") | 520 (insert ";; Gnus article active file for " group "\n\n") |
505 (insert "(setq nnmh-newsgroup-articles '") | 521 (insert "(setq nnmh-newsgroup-articles '") |
506 (insert (prin1-to-string articles) ")\n") | 522 (gnus-prin1 articles) |
507 (write-region (point-min) (point-max) nnmh-file nil 'nomesg) | 523 (insert ")\n")))) |
508 (kill-buffer (current-buffer))))) | |
509 | 524 |
510 (defun nnmh-deletable-article-p (group article) | 525 (defun nnmh-deletable-article-p (group article) |
511 "Say whether ARTICLE in GROUP can be deleted." | 526 "Say whether ARTICLE in GROUP can be deleted." |
512 (let ((path (concat nnmh-current-directory (int-to-string article)))) | 527 (let ((path (concat nnmh-current-directory (int-to-string article)))) |
513 (and (file-writable-p path) | 528 ;; Writable. |
514 (or (not nnmail-keep-last-article) | 529 (and (file-writable-p path) |
515 (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) | 530 ;; We can never delete the last article in the group. |
516 article)))))) | 531 (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) |
532 article))))) | |
517 | 533 |
518 (provide 'nnmh) | 534 (provide 'nnmh) |
519 | 535 |
520 ;;; nnmh.el ends here | 536 ;;; nnmh.el ends here |