aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLars Magne Ingebrigtsen1996-06-29 00:29:17 +0000
committerLars Magne Ingebrigtsen1996-06-29 00:29:17 +0000
commitc4c7f54c6ad77009e46ea66f622ba700d0240127 (patch)
tree20973bb623b236c00476cbdfa39da33a013f0cc7
parentb1cfbae486bde038c68754cd01a8ee84b1c4165d (diff)
downloademacs-c4c7f54c6ad77009e46ea66f622ba700d0240127.tar.gz
emacs-c4c7f54c6ad77009e46ea66f622ba700d0240127.zip
Synched with Gnus 5.2.31.
-rw-r--r--lisp/gnus-cache.el5
-rw-r--r--lisp/gnus-msg.el17
-rw-r--r--lisp/gnus-nocem.el1
-rw-r--r--lisp/gnus-score.el9
-rw-r--r--lisp/message.el17
-rw-r--r--lisp/nnbabyl.el627
-rw-r--r--lisp/nneething.el2
-rw-r--r--lisp/nnfolder.el5
-rw-r--r--lisp/nnheader.el34
-rw-r--r--lisp/nnmail.el16
-rw-r--r--lisp/nnmbox.el2
-rw-r--r--lisp/nnmh.el2
-rw-r--r--lisp/nnspool.el2
13 files changed, 411 insertions, 328 deletions
diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el
index b478acce0f2..d44c4949d15 100644
--- a/lisp/gnus-cache.el
+++ b/lisp/gnus-cache.el
@@ -66,7 +66,10 @@ variable to \"^nnml\".")
66 66
67(defun gnus-cache-open () 67(defun gnus-cache-open ()
68 "Initialize the cache." 68 "Initialize the cache."
69 (gnus-cache-read-active)) 69 (when (or (file-exists-p gnus-cache-directory)
70 (and gnus-use-cache
71 (not (eq gnus-use-cache 'passive))))
72 (gnus-cache-read-active)))
70 73
71(gnus-add-shutdown 'gnus-cache-close 'gnus) 74(gnus-add-shutdown 'gnus-cache-close 'gnus)
72 75
diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
index 5d1778e7aa5..53e915af4c2 100644
--- a/lisp/gnus-msg.el
+++ b/lisp/gnus-msg.el
@@ -55,20 +55,6 @@ message in, you can set this variable to a function that checks the
55current newsgroup name and then returns a suitable group name (or list 55current newsgroup name and then returns a suitable group name (or list
56of names).") 56of names).")
57 57
58(defvar gnus-message-archive-group
59 '((if (message-news-p) "misc-news" "misc-mail"))
60 "*Name of the group in which to save the messages you've written.
61This can either be a string, a list of strings; or an alist
62of regexps/functions/forms to be evaluated to return a string (or a list
63of strings). The functions are called with the name of the current
64group (or nil) as a parameter.
65
66Normally the group names returned by this variable should be
67unprefixed -- which implictly means \"store on the archive server\".
68However, you may wish to store the message on some other server. In
69that case, just return a fully prefixed name of the group --
70\"nnml+private:mail.misc\", for instance.")
71
72(defvar gnus-mailing-list-groups nil 58(defvar gnus-mailing-list-groups nil
73 "*Regexp matching groups that are really mailing lists. 59 "*Regexp matching groups that are really mailing lists.
74This is useful when you're reading a mailing list that has been 60This is useful when you're reading a mailing list that has been
@@ -668,10 +654,9 @@ If YANK is non-nil, include the original article."
668 (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) 654 (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
669 (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) 655 (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
670 (when address 656 (when address
671 (switch-to-buffer gnus-summary-buffer)
672 (message-reply address) 657 (message-reply address)
673 (when yank 658 (when yank
674 (gnus-inews-yank-articles yank))))) 659 (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
675 660
676(defun gnus-bug () 661(defun gnus-bug ()
677 "Send a bug report to the Gnus maintainers." 662 "Send a bug report to the Gnus maintainers."
diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el
index d73cf3382fd..89f27773b8c 100644
--- a/lisp/gnus-nocem.el
+++ b/lisp/gnus-nocem.el
@@ -139,6 +139,7 @@ isn't bound, the message will be used unconditionally.")
139 (nnmail-time-since (nnmail-date-to-time date)) 139 (nnmail-time-since (nnmail-date-to-time date))
140 (nnmail-days-to-time gnus-nocem-expiry-wait))) 140 (nnmail-days-to-time gnus-nocem-expiry-wait)))
141 (gnus-request-article-this-buffer (mail-header-number header) group) 141 (gnus-request-article-this-buffer (mail-header-number header) group)
142 (goto-char (point-min))
142 ;; The article has to have proper NoCeM headers. 143 ;; The article has to have proper NoCeM headers.
143 (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) 144 (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
144 (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) 145 (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
index c0686ef6903..523fa13587f 100644
--- a/lisp/gnus-score.el
+++ b/lisp/gnus-score.el
@@ -551,7 +551,7 @@ If optional argument `SILENT' is nil, show effect of score entry."
551 ((eq type 'f) 551 ((eq type 'f)
552 (setq match (gnus-simplify-subject-fuzzy match)))) 552 (setq match (gnus-simplify-subject-fuzzy match))))
553 (let ((score (gnus-score-default score)) 553 (let ((score (gnus-score-default score))
554 (header (downcase header)) 554 (header (format "%s" (downcase header)))
555 new) 555 new)
556 (and prompt (setq match (read-string 556 (and prompt (setq match (read-string
557 (format "Match %s on %s, %s: " 557 (format "Match %s on %s, %s: "
@@ -566,6 +566,9 @@ If optional argument `SILENT' is nil, show effect of score entry."
566 (int-to-string match) 566 (int-to-string match)
567 match)))) 567 match))))
568 568
569 ;; Get rid of string props.
570 (setq match (format "%s" match))
571
569 ;; If this is an integer comparison, we transform from string to int. 572 ;; If this is an integer comparison, we transform from string to int.
570 (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) 573 (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
571 (setq match (string-to-int match))) 574 (setq match (string-to-int match)))
@@ -720,11 +723,11 @@ SCORE is the score to add."
720 (setq score (gnus-score-default score)) 723 (setq score (gnus-score-default score))
721 (when (gnus-buffer-live-p gnus-summary-buffer) 724 (when (gnus-buffer-live-p gnus-summary-buffer)
722 (save-excursion 725 (save-excursion
723 (set-buffer gnus-summary-buffer)
724 (save-restriction 726 (save-restriction
725 (goto-char (point-min)) 727 (goto-char (point-min))
726 (let ((id (mail-fetch-field "message-id"))) 728 (let ((id (mail-fetch-field "message-id")))
727 (when id 729 (when id
730 (set-buffer gnus-summary-buffer)
728 (gnus-summary-score-entry 731 (gnus-summary-score-entry
729 "references" (concat id "[ \t]*$") 'r 732 "references" (concat id "[ \t]*$") 'r
730 score (current-time-string) nil t))))))) 733 score (current-time-string) nil t)))))))
@@ -735,11 +738,11 @@ SCORE is the score to add."
735 (setq score (gnus-score-default score)) 738 (setq score (gnus-score-default score))
736 (when (gnus-buffer-live-p gnus-summary-buffer) 739 (when (gnus-buffer-live-p gnus-summary-buffer)
737 (save-excursion 740 (save-excursion
738 (set-buffer gnus-summary-buffer)
739 (save-restriction 741 (save-restriction
740 (goto-char (point-min)) 742 (goto-char (point-min))
741 (let ((id (mail-fetch-field "message-id"))) 743 (let ((id (mail-fetch-field "message-id")))
742 (when id 744 (when id
745 (set-buffer gnus-summary-buffer)
743 (gnus-summary-score-entry 746 (gnus-summary-score-entry
744 "references" id 's 747 "references" id 's
745 score (current-time-string)))))))) 748 score (current-time-string))))))))
diff --git a/lisp/message.el b/lisp/message.el
index 0e94d64b402..20142f1728a 100644
--- a/lisp/message.el
+++ b/lisp/message.el
@@ -40,7 +40,6 @@
40 (require 'mail-abbrevs) 40 (require 'mail-abbrevs)
41 (require 'mailabbrev)) 41 (require 'mailabbrev))
42 42
43;;;###autoload
44(defvar message-directory "~/Mail/" 43(defvar message-directory "~/Mail/"
45 "*Directory from which all other mail file variables are derived.") 44 "*Directory from which all other mail file variables are derived.")
46 45
@@ -164,9 +163,8 @@ If t, use `message-user-organization-file'.")
164(defvar message-user-organization-file "/usr/lib/news/organization" 163(defvar message-user-organization-file "/usr/lib/news/organization"
165 "*Local news organization file.") 164 "*Local news organization file.")
166 165
167;;;###autoload 166(defvar message-autosave-directory "~/"
168(defvar message-autosave-directory 167 ; (concat (file-name-as-directory message-directory) "drafts/")
169 (concat (file-name-as-directory message-directory) "drafts/")
170 "*Directory where message autosaves buffers. 168 "*Directory where message autosaves buffers.
171If nil, message won't autosave.") 169If nil, message won't autosave.")
172 170
@@ -1095,6 +1093,8 @@ Puts point before the text and mark after.
1095Normally indents each nonblank line ARG spaces (default 3). However, 1093Normally indents each nonblank line ARG spaces (default 3). However,
1096if `message-yank-prefix' is non-nil, insert that prefix on each line. 1094if `message-yank-prefix' is non-nil, insert that prefix on each line.
1097 1095
1096This function uses `message-cite-function' to do the actual citing.
1097
1098Just \\[universal-argument] as argument means don't indent, insert no 1098Just \\[universal-argument] as argument means don't indent, insert no
1099prefix, and don't delete any headers." 1099prefix, and don't delete any headers."
1100 (interactive "P") 1100 (interactive "P")
@@ -1531,8 +1531,9 @@ the user from the mailer."
1531 ;; Check "Shoot me". 1531 ;; Check "Shoot me".
1532 (or (message-check-element 'shoot) 1532 (or (message-check-element 'shoot)
1533 (save-excursion 1533 (save-excursion
1534 (if (search-forward 1534 (if (re-search-forward
1535 ".i-have-a-misconfigured-system-so-shoot-me" nil t) 1535 "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me"
1536 nil t)
1536 (y-or-n-p 1537 (y-or-n-p
1537 "You appear to have a misconfigured system. Really post? ") 1538 "You appear to have a misconfigured system. Really post? ")
1538 t))) 1539 t)))
@@ -2489,7 +2490,9 @@ Headers already prepared in the buffer are not modified."
2489 follow-to))))) 2490 follow-to)))))
2490 (widen)) 2491 (widen))
2491 2492
2492 (message-pop-to-buffer (message-buffer-name "reply" from)) 2493 (message-pop-to-buffer (message-buffer-name
2494 (if wide "wide reply" "reply") from
2495 (if wide to-address nil)))
2493 2496
2494 (setq message-reply-headers 2497 (setq message-reply-headers
2495 (vector 0 subject from date message-id references 0 0 "")) 2498 (vector 0 subject from date message-id references 0 0 ""))
diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el
index 0d9ad2c1e09..330fe905744 100644
--- a/lisp/nnbabyl.el
+++ b/lisp/nnbabyl.el
@@ -1,5 +1,5 @@
1;;; nnbabyl.el --- rmail mbox access for Gnus 1;;; nnbabyl.el --- rmail mbox access for Gnus
2;; Copyright (C) 1995 Free Software Foundation, Inc. 2;; Copyright (C) 1995,96 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>
@@ -18,8 +18,9 @@
18;; GNU General Public License for more details. 18;; GNU General Public License for more details.
19 19
20;; You should have received a copy of the GNU General Public License 20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING. If not, write to 21;; along with GNU Emacs; see the file COPYING. If not, write to the
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 22;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23;; Boston, MA 02111-1307, USA.
23 24
24;;; Commentary: 25;;; Commentary:
25 26
@@ -31,17 +32,21 @@
31(require 'nnheader) 32(require 'nnheader)
32(require 'rmail) 33(require 'rmail)
33(require 'nnmail) 34(require 'nnmail)
35(require 'nnoo)
36(eval-when-compile (require 'cl))
34 37
35(defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL") 38(nnoo-declare nnbabyl)
39
40(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
36 "The name of the rmail box file in the users home directory.") 41 "The name of the rmail box file in the users home directory.")
37 42
38(defvar nnbabyl-active-file (expand-file-name "~/.rmail-active") 43(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
39 "The name of the active file for the rmail box.") 44 "The name of the active file for the rmail box.")
40 45
41(defvar nnbabyl-get-new-mail t 46(defvoo nnbabyl-get-new-mail t
42 "If non-nil, nnbabyl will check the incoming mail file and split the mail.") 47 "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
43 48
44(defvar nnbabyl-prepare-save-mail-hook nil 49(defvoo nnbabyl-prepare-save-mail-hook nil
45 "Hook run narrowed to an article before saving.") 50 "Hook run narrowed to an article before saving.")
46 51
47 52
@@ -51,223 +56,219 @@
51(defconst nnbabyl-version "nnbabyl 1.0" 56(defconst nnbabyl-version "nnbabyl 1.0"
52 "nnbabyl version.") 57 "nnbabyl version.")
53 58
54(defvar nnbabyl-mbox-buffer nil) 59(defvoo nnbabyl-mbox-buffer nil)
55(defvar nnbabyl-current-group nil) 60(defvoo nnbabyl-current-group nil)
56(defvar nnbabyl-status-string "") 61(defvoo nnbabyl-status-string "")
57(defvar nnbabyl-group-alist nil) 62(defvoo nnbabyl-group-alist nil)
58(defvar nnbabyl-active-timestamp nil) 63(defvoo nnbabyl-active-timestamp nil)
59 64
60 65(defvoo nnbabyl-previous-buffer-mode nil)
61 66
62(defvar nnbabyl-current-server nil) 67(eval-and-compile
63(defvar nnbabyl-server-alist nil) 68 (autoload 'gnus-set-text-properties "gnus-ems"))
64(defvar nnbabyl-server-variables
65 (list
66 (list 'nnbabyl-mbox-file nnbabyl-mbox-file)
67 (list 'nnbabyl-active-file nnbabyl-active-file)
68 (list 'nnbabyl-get-new-mail nnbabyl-get-new-mail)
69 '(nnbabyl-current-group nil)
70 '(nnbabyl-status-string "")
71 '(nnbabyl-group-alist nil)))
72 69
73 70
74 71
75;;; Interface functions 72;;; Interface functions
76 73
77(defun nnbabyl-retrieve-headers (sequence &optional newsgroup server) 74(nnoo-define-basics nnbabyl)
75
76(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
78 (save-excursion 77 (save-excursion
79 (set-buffer nntp-server-buffer) 78 (set-buffer nntp-server-buffer)
80 (erase-buffer) 79 (erase-buffer)
81 (let ((number (length sequence)) 80 (let ((number (length articles))
82 (count 0) 81 (count 0)
82 (delim (concat "^" nnbabyl-mail-delimiter))
83 article art-string start stop) 83 article art-string start stop)
84 (nnbabyl-possibly-change-newsgroup newsgroup) 84 (nnbabyl-possibly-change-newsgroup group server)
85 (if (stringp (car sequence)) 85 (while (setq article (pop articles))
86 'headers 86 (setq art-string (nnbabyl-article-string article))
87 (while sequence 87 (set-buffer nnbabyl-mbox-buffer)
88 (setq article (car sequence)) 88 (beginning-of-line)
89 (setq art-string (nnbabyl-article-string article)) 89 (when (or (search-forward art-string nil t)
90 (set-buffer nnbabyl-mbox-buffer)
91 (if (or (search-forward art-string nil t)
92 (search-backward art-string nil t)) 90 (search-backward art-string nil t))
93 (progn 91 (re-search-backward delim nil t)
94 (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) 92 (while (and (not (looking-at ".+:"))
95 (while (and (not (looking-at ".+:")) 93 (zerop (forward-line 1))))
96 (zerop (forward-line 1)))) 94 (setq start (point))
97 (setq start (point)) 95 (search-forward "\n\n" nil t)
98 (search-forward "\n\n" nil t) 96 (setq stop (1- (point)))
99 (setq stop (1- (point))) 97 (set-buffer nntp-server-buffer)
100 (set-buffer nntp-server-buffer) 98 (insert "221 ")
101 (insert "221 " (int-to-string article) " Article retrieved.\n") 99 (princ article (current-buffer))
102 (insert-buffer-substring nnbabyl-mbox-buffer start stop) 100 (insert " Article retrieved.\n")
103 (goto-char (point-max)) 101 (insert-buffer-substring nnbabyl-mbox-buffer start stop)
104 (insert ".\n"))) 102 (goto-char (point-max))
105 (setq sequence (cdr sequence)) 103 (insert ".\n"))
106 (setq count (1+ count))
107 (and (numberp nnmail-large-newsgroup)
108 (> number nnmail-large-newsgroup)
109 (zerop (% count 20))
110 gnus-verbose-backends
111 (message "nnbabyl: Receiving headers... %d%%"
112 (/ (* count 100) number))))
113
114 (and (numberp nnmail-large-newsgroup) 104 (and (numberp nnmail-large-newsgroup)
115 (> number nnmail-large-newsgroup) 105 (> number nnmail-large-newsgroup)
116 gnus-verbose-backends 106 (zerop (% (incf count) 20))
117 (message "nnbabyl: Receiving headers...done")) 107 (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
118 108 (/ (* count 100) number))))
119 ;; Fold continuation lines. 109
120 (set-buffer nntp-server-buffer) 110 (and (numberp nnmail-large-newsgroup)
121 (goto-char (point-min)) 111 (> number nnmail-large-newsgroup)
122 (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) 112 (nnheader-message 5 "nnbabyl: Receiving headers...done"))
123 (replace-match " " t t)) 113
124 'headers)))) 114 (set-buffer nntp-server-buffer)
125 115 (nnheader-fold-continuation-lines)
126(defun nnbabyl-open-server (server &optional defs) 116 'headers)))
127 (nnheader-init-server-buffer) 117
128 (if (equal server nnbabyl-current-server) 118(deffoo nnbabyl-open-server (server &optional defs)
129 t 119 (nnoo-change-server 'nnbabyl server defs)
130 (if nnbabyl-current-server 120 (cond
131 (setq nnbabyl-server-alist 121 ((not (file-exists-p nnbabyl-mbox-file))
132 (cons (list nnbabyl-current-server 122 (nnbabyl-close-server)
133 (nnheader-save-variables nnbabyl-server-variables)) 123 (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
134 nnbabyl-server-alist))) 124 ((file-directory-p nnbabyl-mbox-file)
135 (let ((state (assoc server nnbabyl-server-alist))) 125 (nnbabyl-close-server)
136 (if state 126 (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
137 (progn 127 (t
138 (nnheader-restore-variables (nth 1 state)) 128 (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
139 (setq nnbabyl-server-alist (delq state nnbabyl-server-alist))) 129 nnbabyl-mbox-file)
140 (nnheader-set-init-variables nnbabyl-server-variables defs))) 130 t)))
141 (setq nnbabyl-current-server server))) 131
142 132(deffoo nnbabyl-close-server (&optional server)
143(defun nnbabyl-close-server (&optional server) 133 ;; Restore buffer mode.
134 (when (and (nnbabyl-server-opened)
135 nnbabyl-previous-buffer-mode)
136 (save-excursion
137 (set-buffer nnbabyl-mbox-buffer)
138 (narrow-to-region
139 (caar nnbabyl-previous-buffer-mode)
140 (cdar nnbabyl-previous-buffer-mode))
141 (funcall (cdr nnbabyl-previous-buffer-mode))))
142 (nnoo-close-server 'nnbabyl server)
143 (setq nnbabyl-mbox-buffer nil)
144 t) 144 t)
145 145
146(defun nnbabyl-server-opened (&optional server) 146(deffoo nnbabyl-server-opened (&optional server)
147 (and (equal server nnbabyl-current-server) 147 (and (nnoo-current-server-p 'nnbabyl server)
148 nnbabyl-mbox-buffer 148 nnbabyl-mbox-buffer
149 (buffer-name nnbabyl-mbox-buffer) 149 (buffer-name nnbabyl-mbox-buffer)
150 nntp-server-buffer 150 nntp-server-buffer
151 (buffer-name nntp-server-buffer))) 151 (buffer-name nntp-server-buffer)))
152 152
153(defun nnbabyl-status-message (&optional server) 153(deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
154 nnbabyl-status-string) 154 (nnbabyl-possibly-change-newsgroup newsgroup server)
155
156(defun nnbabyl-request-article (article &optional newsgroup server buffer)
157 (nnbabyl-possibly-change-newsgroup newsgroup)
158 (if (stringp article)
159 nil
160 (save-excursion
161 (set-buffer nnbabyl-mbox-buffer)
162 (goto-char (point-min))
163 (if (search-forward (nnbabyl-article-string article) nil t)
164 (let (start stop summary-line)
165 (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
166 (while (and (not (looking-at ".+:"))
167 (zerop (forward-line 1))))
168 (setq start (point))
169 (or (and (re-search-forward
170 (concat "^" nnbabyl-mail-delimiter) nil t)
171 (forward-line -1))
172 (goto-char (point-max)))
173 (setq stop (point))
174 (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
175 (set-buffer nntp-server-buffer)
176 (erase-buffer)
177 (insert-buffer-substring nnbabyl-mbox-buffer start stop)
178 (goto-char (point-min))
179 ;; If there is an EOOH header, then we have to remove some
180 ;; duplicated headers.
181 (setq summary-line (looking-at "Summary-line:"))
182 (if (search-forward "\n*** EOOH ***" nil t)
183 (if summary-line
184 ;; The headers to be deleted are located before the
185 ;; EOOH line...
186 (delete-region (point-min)
187 (progn (forward-line 1) (point)))
188 ;; ...or after.
189 (delete-region (progn (beginning-of-line) (point))
190 (or (search-forward "\n\n" nil t)
191 (point)))))
192 t))))))
193
194(defun nnbabyl-request-group (group &optional server dont-check)
195 (save-excursion 155 (save-excursion
196 (if (nnbabyl-possibly-change-newsgroup group) 156 (set-buffer nnbabyl-mbox-buffer)
197 (if dont-check 157 (goto-char (point-min))
198 t 158 (when (search-forward (nnbabyl-article-string article) nil t)
199 (nnbabyl-get-new-mail group) 159 (let (start stop summary-line)
200 (save-excursion 160 (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
201 (set-buffer nntp-server-buffer) 161 (while (and (not (looking-at ".+:"))
202 (erase-buffer) 162 (zerop (forward-line 1))))
203 (let ((active (assoc group nnbabyl-group-alist))) 163 (setq start (point))
204 (insert (format "211 %d %d %d %s\n" 164 (or (and (re-search-forward
205 (1+ (- (cdr (car (cdr active))) 165 (concat "^" nnbabyl-mail-delimiter) nil t)
206 (car (car (cdr active))))) 166 (forward-line -1))
207 (car (car (cdr active))) 167 (goto-char (point-max)))
208 (cdr (car (cdr active))) 168 (setq stop (point))
209 (car active)))) 169 (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
210 t))))) 170 (set-buffer nntp-server-buffer)
211 171 (erase-buffer)
212(defun nnbabyl-close-group (group &optional server) 172 (insert-buffer-substring nnbabyl-mbox-buffer start stop)
173 (goto-char (point-min))
174 ;; If there is an EOOH header, then we have to remove some
175 ;; duplicated headers.
176 (setq summary-line (looking-at "Summary-line:"))
177 (when (search-forward "\n*** EOOH ***" nil t)
178 (if summary-line
179 ;; The headers to be deleted are located before the
180 ;; EOOH line...
181 (delete-region (point-min) (progn (forward-line 1)
182 (point)))
183 ;; ...or after.
184 (delete-region (progn (beginning-of-line) (point))
185 (or (search-forward "\n\n" nil t)
186 (point)))))
187 (if (numberp article)
188 (cons nnbabyl-current-group article)
189 (nnbabyl-article-group-number)))))))
190
191(deffoo nnbabyl-request-group (group &optional server dont-check)
192 (let ((active (cadr (assoc group nnbabyl-group-alist))))
193 (save-excursion
194 (cond
195 ((or (null active)
196 (null (nnbabyl-possibly-change-newsgroup group server)))
197 (nnheader-report 'nnbabyl "No such group: %s" group))
198 (dont-check
199 (nnheader-report 'nnbabyl "Selected group %s" group)
200 (nnheader-insert ""))
201 (t
202 (nnheader-report 'nnbabyl "Selected group %s" group)
203 (nnheader-insert "211 %d %d %d %s\n"
204 (1+ (- (cdr active) (car active)))
205 (car active) (cdr active) group))))))
206
207(deffoo nnbabyl-request-scan (&optional group server)
208 (nnbabyl-read-mbox)
209 (nnmail-get-new-mail
210 'nnbabyl
211 (lambda ()
212 (save-excursion
213 (set-buffer nnbabyl-mbox-buffer)
214 (save-buffer)))
215 nnbabyl-mbox-file group
216 (lambda ()
217 (save-excursion
218 (let ((in-buf (current-buffer)))
219 (goto-char (point-min))
220 (while (search-forward "\n\^_\n" nil t)
221 (delete-char -1))
222 (set-buffer nnbabyl-mbox-buffer)
223 (goto-char (point-max))
224 (search-backward "\n\^_" nil t)
225 (goto-char (match-end 0))
226 (insert-buffer-substring in-buf)))
227 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
228
229(deffoo nnbabyl-close-group (group &optional server)
213 t) 230 t)
214 231
215(defun nnbabyl-request-create-group (group &optional server) 232(deffoo nnbabyl-request-create-group (group &optional server)
216 (nnmail-activate 'nnbabyl) 233 (nnmail-activate 'nnbabyl)
217 (or (assoc group nnbabyl-group-alist) 234 (unless (assoc group nnbabyl-group-alist)
218 (let (active) 235 (setq nnbabyl-group-alist (cons (list group (cons 1 0))
219 (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0))) 236 nnbabyl-group-alist))
220 nnbabyl-group-alist)) 237 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
221 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))
222 t) 238 t)
223 239
224(defun nnbabyl-request-list (&optional server) 240(deffoo nnbabyl-request-list (&optional server)
225 (if server (nnbabyl-get-new-mail))
226 (save-excursion 241 (save-excursion
227 (or (nnmail-find-file nnbabyl-active-file) 242 (nnmail-find-file nnbabyl-active-file)
228 (progn 243 (setq nnbabyl-group-alist (nnmail-get-active))))
229 (setq nnbabyl-group-alist (nnmail-get-active))
230 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
231 (nnmail-find-file nnbabyl-active-file)))))
232 244
233(defun nnbabyl-request-newgroups (date &optional server) 245(deffoo nnbabyl-request-newgroups (date &optional server)
234 (nnbabyl-request-list server)) 246 (nnbabyl-request-list server))
235 247
236(defun nnbabyl-request-list-newsgroups (&optional server) 248(deffoo nnbabyl-request-list-newsgroups (&optional server)
237 (setq nnbabyl-status-string "nnbabyl: LIST NEWSGROUPS is not implemented.") 249 (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
238 nil)
239
240(defun nnbabyl-request-post (&optional server)
241 (mail-send-and-exit nil))
242
243(defalias 'nnbabyl-request-post-buffer 'nnmail-request-post-buffer)
244 250
245(defun nnbabyl-request-expire-articles 251(deffoo nnbabyl-request-expire-articles
246 (articles newsgroup &optional server force) 252 (articles newsgroup &optional server force)
247 (nnbabyl-possibly-change-newsgroup newsgroup) 253 (nnbabyl-possibly-change-newsgroup newsgroup server)
248 (let* ((days (or (and nnmail-expiry-wait-function 254 (let* ((is-old t)
249 (funcall nnmail-expiry-wait-function newsgroup))
250 nnmail-expiry-wait))
251 (is-old t)
252 rest) 255 rest)
253 (nnmail-activate 'nnbabyl) 256 (nnmail-activate 'nnbabyl)
254 257
255 (save-excursion 258 (save-excursion
256 (set-buffer nnbabyl-mbox-buffer) 259 (set-buffer nnbabyl-mbox-buffer)
257 (set-text-properties (point-min) (point-max) nil) 260 (gnus-set-text-properties (point-min) (point-max) nil)
258 (while (and articles is-old) 261 (while (and articles is-old)
259 (goto-char (point-min)) 262 (goto-char (point-min))
260 (if (search-forward (nnbabyl-article-string (car articles)) nil t) 263 (if (search-forward (nnbabyl-article-string (car articles)) nil t)
261 (if (or force 264 (if (setq is-old
262 (setq is-old 265 (nnmail-expired-article-p
263 (> (nnmail-days-between 266 newsgroup
264 (current-time-string) 267 (buffer-substring
265 (buffer-substring 268 (point) (progn (end-of-line) (point))) force))
266 (point) (progn (end-of-line) (point))))
267 days)))
268 (progn 269 (progn
269 (and gnus-verbose-backends 270 (nnheader-message 5 "Deleting article %d in %s..."
270 (message "Deleting article %s..." (car articles))) 271 (car articles) newsgroup)
271 (nnbabyl-delete-mail)) 272 (nnbabyl-delete-mail))
272 (setq rest (cons (car articles) rest)))) 273 (setq rest (cons (car articles) rest))))
273 (setq articles (cdr articles))) 274 (setq articles (cdr articles)))
@@ -283,9 +284,9 @@
283 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) 284 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
284 (nconc rest articles)))) 285 (nconc rest articles))))
285 286
286(defun nnbabyl-request-move-article 287(deffoo nnbabyl-request-move-article
287 (article group server accept-form &optional last) 288 (article group server accept-form &optional last)
288 (nnbabyl-possibly-change-newsgroup group) 289 (nnbabyl-possibly-change-newsgroup group server)
289 (let ((buf (get-buffer-create " *nnbabyl move*")) 290 (let ((buf (get-buffer-create " *nnbabyl move*"))
290 result) 291 result)
291 (and 292 (and
@@ -310,7 +311,9 @@
310 (and last (save-buffer)))) 311 (and last (save-buffer))))
311 result)) 312 result))
312 313
313(defun nnbabyl-request-accept-article (group &optional last) 314(deffoo nnbabyl-request-accept-article (group &optional server last)
315 (nnbabyl-possibly-change-newsgroup group server)
316 (nnmail-check-syntax)
314 (let ((buf (current-buffer)) 317 (let ((buf (current-buffer))
315 result beg) 318 result beg)
316 (and 319 (and
@@ -330,14 +333,13 @@
330 (goto-char (point-max)) 333 (goto-char (point-max))
331 (search-backward "\n\^_") 334 (search-backward "\n\^_")
332 (goto-char (match-end 0)) 335 (goto-char (match-end 0))
333 (insert-buffer buf) 336 (insert-buffer-substring buf)
334 (and last (progn 337 (when last
335 (save-buffer) 338 (save-buffer)
336 (nnmail-save-active 339 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
337 nnbabyl-group-alist nnbabyl-active-file)))
338 result)))) 340 result))))
339 341
340(defun nnbabyl-request-replace-article (article group buffer) 342(deffoo nnbabyl-request-replace-article (article group buffer)
341 (nnbabyl-possibly-change-newsgroup group) 343 (nnbabyl-possibly-change-newsgroup group)
342 (save-excursion 344 (save-excursion
343 (set-buffer nnbabyl-mbox-buffer) 345 (set-buffer nnbabyl-mbox-buffer)
@@ -349,8 +351,50 @@
349 (save-buffer) 351 (save-buffer)
350 t))) 352 t)))
351 353
354(deffoo nnbabyl-request-delete-group (group &optional force server)
355 (nnbabyl-possibly-change-newsgroup group server)
356 ;; Delete all articles in GROUP.
357 (if (not force)
358 () ; Don't delete the articles.
359 (save-excursion
360 (set-buffer nnbabyl-mbox-buffer)
361 (goto-char (point-min))
362 ;; Delete all articles in this group.
363 (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
364 found)
365 (while (search-forward ident nil t)
366 (setq found t)
367 (nnbabyl-delete-mail))
368 (and found (save-buffer)))))
369 ;; Remove the group from all structures.
370 (setq nnbabyl-group-alist
371 (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
372 nnbabyl-current-group nil)
373 ;; Save the active file.
374 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
375 t)
376
377(deffoo nnbabyl-request-rename-group (group new-name &optional server)
378 (nnbabyl-possibly-change-newsgroup group server)
379 (save-excursion
380 (set-buffer nnbabyl-mbox-buffer)
381 (goto-char (point-min))
382 (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
383 (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
384 found)
385 (while (search-forward ident nil t)
386 (replace-match new-ident t t)
387 (setq found t))
388 (and found (save-buffer))))
389 (let ((entry (assoc group nnbabyl-group-alist)))
390 (and entry (setcar entry new-name))
391 (setq nnbabyl-current-group nil)
392 ;; Save the new group alist.
393 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
394 t))
395
352 396
353;;; Low-Level Interface 397;;; Internal functions.
354 398
355;; If FORCE, delete article no matter how many X-Gnus-Newsgroup 399;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
356;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox 400;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
@@ -383,7 +427,10 @@
383 (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) 427 (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
384 (delete-region (point-min) (point-max)))))) 428 (delete-region (point-min) (point-max))))))
385 429
386(defun nnbabyl-possibly-change-newsgroup (newsgroup) 430(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
431 (when (and server
432 (not (nnbabyl-server-opened server)))
433 (nnbabyl-open-server server))
387 (if (or (not nnbabyl-mbox-buffer) 434 (if (or (not nnbabyl-mbox-buffer)
388 (not (buffer-name nnbabyl-mbox-buffer))) 435 (not (buffer-name nnbabyl-mbox-buffer)))
389 (save-excursion (nnbabyl-read-mbox))) 436 (save-excursion (nnbabyl-read-mbox)))
@@ -392,34 +439,44 @@
392 (if newsgroup 439 (if newsgroup
393 (if (assoc newsgroup nnbabyl-group-alist) 440 (if (assoc newsgroup nnbabyl-group-alist)
394 (setq nnbabyl-current-group newsgroup) 441 (setq nnbabyl-current-group newsgroup)
395 (setq nnbabyl-status-string "No such group in file") 442 (nnheader-report 'nnbabyl "No such group in file"))
396 nil))) 443 t))
397 444
398(defun nnbabyl-article-string (article) 445(defun nnbabyl-article-string (article)
399 (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" 446 (if (numberp article)
400 (int-to-string article) " ")) 447 (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
448 (int-to-string article) " ")
449 (concat "\nMessage-ID: " article)))
450
451(defun nnbabyl-article-group-number ()
452 (save-excursion
453 (goto-char (point-min))
454 (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
455 nil t)
456 (cons (buffer-substring (match-beginning 1) (match-end 1))
457 (string-to-int
458 (buffer-substring (match-beginning 2) (match-end 2)))))))
401 459
402(defun nnbabyl-insert-lines () 460(defun nnbabyl-insert-lines ()
403 "Insert how many lines and chars there are in the body of the mail." 461 "Insert how many lines and chars there are in the body of the mail."
404 (let (lines chars) 462 (let (lines chars)
405 (save-excursion 463 (save-excursion
406 (goto-char (point-min)) 464 (goto-char (point-min))
407 (if (search-forward "\n\n" nil t) 465 (when (search-forward "\n\n" nil t)
408 (progn 466 ;; There may be an EOOH line here...
409 ;; There may be an EOOH line here... 467 (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
410 (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*") 468 (search-forward "\n\n" nil t))
411 (search-forward "\n\n" nil t)) 469 (setq chars (- (point-max) (point))
412 (setq chars (- (point-max) (point))) 470 lines (max (- (count-lines (point) (point-max)) 1) 0))
413 (setq lines (- (count-lines (point) (point-max)) 1)) 471 ;; Move back to the end of the headers.
414 ;; Move back to the end of the headers. 472 (goto-char (point-min))
415 (goto-char (point-min)) 473 (search-forward "\n\n" nil t)
416 (search-forward "\n\n" nil t) 474 (forward-char -1)
417 (forward-char -1) 475 (save-excursion
418 (save-excursion 476 (when (re-search-backward "^Lines: " nil t)
419 (if (re-search-backward "^Lines: " nil t) 477 (delete-region (point) (progn (forward-line 1) (point)))))
420 (delete-region (point) (progn (forward-line 1) (point))))) 478 (insert (format "Lines: %d\n" lines))
421 (insert (format "Lines: %d\n" lines)) 479 chars))))
422 chars)))))
423 480
424(defun nnbabyl-save-mail () 481(defun nnbabyl-save-mail ()
425 ;; Called narrowed to an article. 482 ;; Called narrowed to an article.
@@ -449,14 +506,14 @@
449 (forward-char -1) 506 (forward-char -1)
450 (while group-art 507 (while group-art
451 (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" 508 (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
452 (car (car group-art)) (cdr (car group-art)) 509 (caar group-art) (cdar group-art)
453 (current-time-string))) 510 (current-time-string)))
454 (setq group-art (cdr group-art))))) 511 (setq group-art (cdr group-art)))))
455 t)) 512 t))
456 513
457(defun nnbabyl-active-number (group) 514(defun nnbabyl-active-number (group)
458 ;; Find the next article number in GROUP. 515 ;; Find the next article number in GROUP.
459 (let ((active (car (cdr (assoc group nnbabyl-group-alist))))) 516 (let ((active (cadr (assoc group nnbabyl-group-alist))))
460 (if active 517 (if active
461 (setcdr active (1+ (cdr active))) 518 (setcdr active (1+ (cdr active)))
462 ;; This group is new, so we create a new entry for it. 519 ;; This group is new, so we create a new entry for it.
@@ -468,47 +525,70 @@
468 525
469(defun nnbabyl-read-mbox () 526(defun nnbabyl-read-mbox ()
470 (nnmail-activate 'nnbabyl) 527 (nnmail-activate 'nnbabyl)
471 (or (file-exists-p nnbabyl-mbox-file) 528 (unless (file-exists-p nnbabyl-mbox-file)
472 (save-excursion 529 ;; Create a new, empty RMAIL mbox file.
473 (set-buffer (setq nnbabyl-mbox-buffer 530 (save-excursion
474 (create-file-buffer nnbabyl-mbox-file))) 531 (set-buffer (setq nnbabyl-mbox-buffer
475 (setq buffer-file-name nnbabyl-mbox-file) 532 (create-file-buffer nnbabyl-mbox-file)))
476 (insert "BABYL OPTIONS:\n\n\^_") 533 (setq buffer-file-name nnbabyl-mbox-file)
477 (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))) 534 (insert "BABYL OPTIONS:\n\n\^_")
535 (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
478 536
479 (if (and nnbabyl-mbox-buffer 537 (if (and nnbabyl-mbox-buffer
480 (buffer-name nnbabyl-mbox-buffer) 538 (buffer-name nnbabyl-mbox-buffer)
481 (save-excursion 539 (save-excursion
482 (set-buffer nnbabyl-mbox-buffer) 540 (set-buffer nnbabyl-mbox-buffer)
483 (= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file))))) 541 (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
484 () 542 () ; This buffer hasn't changed since we read it last. Possibly.
485 (save-excursion 543 (save-excursion
486 (let ((delim (concat "^" nnbabyl-mail-delimiter)) 544 (let ((delim (concat "^" nnbabyl-mail-delimiter))
487 start end) 545 (alist nnbabyl-group-alist)
546 start end number)
488 (set-buffer (setq nnbabyl-mbox-buffer 547 (set-buffer (setq nnbabyl-mbox-buffer
489 (nnheader-find-file-noselect 548 (nnheader-find-file-noselect
490 nnbabyl-mbox-file nil 'raw))) 549 nnbabyl-mbox-file nil 'raw)))
550 ;; Save previous buffer mode.
551 (setq nnbabyl-previous-buffer-mode
552 (cons (cons (point-min) (point-max))
553 major-mode))
554
491 (buffer-disable-undo (current-buffer)) 555 (buffer-disable-undo (current-buffer))
492 (widen) 556 (widen)
493 (setq buffer-read-only nil) 557 (setq buffer-read-only nil)
494 (fundamental-mode) 558 (fundamental-mode)
559
560 ;; Go through the group alist and compare against
561 ;; the rmail file.
562 (while alist
563 (goto-char (point-max))
564 (when (and (re-search-backward
565 (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
566 (caar alist)) nil t)
567 (> (setq number
568 (string-to-number
569 (buffer-substring
570 (match-beginning 1) (match-end 1))))
571 (cdadar alist)))
572 (setcdr (cadar alist) (1+ number)))
573 (setq alist (cdr alist)))
495 574
575 ;; We go through the mbox and make sure that each and
576 ;; every mail belongs to some group or other.
496 (goto-char (point-min)) 577 (goto-char (point-min))
497 (re-search-forward delim nil t) 578 (re-search-forward delim nil t)
498 (setq start (match-end 0)) 579 (setq start (match-end 0))
499 (while (re-search-forward delim nil t) 580 (while (re-search-forward delim nil t)
500 (setq end (match-end 0)) 581 (setq end (match-end 0))
501 (or (search-backward "\nX-Gnus-Newsgroup: " start t) 582 (unless (search-backward "\nX-Gnus-Newsgroup: " start t)
502 (progn 583 (goto-char end)
503 (goto-char end) 584 (save-excursion
504 (save-excursion 585 (save-restriction
505 (save-restriction 586 (narrow-to-region (goto-char start) end)
506 (goto-char start) 587 (nnbabyl-save-mail)
507 (narrow-to-region start end) 588 (setq end (point-max)))))
508 (nnbabyl-save-mail)
509 (setq end (point-max))))))
510 (goto-char (setq start end))) 589 (goto-char (setq start end)))
511 (and (buffer-modified-p (current-buffer)) (save-buffer)) 590 (when (buffer-modified-p (current-buffer))
591 (save-buffer))
512 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) 592 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
513 593
514(defun nnbabyl-remove-incoming-delims () 594(defun nnbabyl-remove-incoming-delims ()
@@ -516,62 +596,29 @@
516 (while (search-forward "\^_" nil t) 596 (while (search-forward "\^_" nil t)
517 (replace-match "?" t t))) 597 (replace-match "?" t t)))
518 598
519(defun nnbabyl-get-new-mail (&optional group) 599(defun nnbabyl-check-mbox ()
520 "Read new incoming mail." 600 "Go through the nnbabyl mbox and make sure that no article numbers are reused."
521 (let* ((spools (nnmail-get-spool-files group)) 601 (interactive)
522 (group-in group) 602 (let ((idents (make-vector 1000 0))
523 incoming incomings) 603 id)
524 (nnbabyl-read-mbox) 604 (save-excursion
525 (if (or (not nnbabyl-get-new-mail) (not nnmail-spool-file)) 605 (when (or (not nnbabyl-mbox-buffer)
526 () 606 (not (buffer-name nnbabyl-mbox-buffer)))
527 ;; We go through all the existing spool files and split the 607 (nnbabyl-read-mbox))
528 ;; mail from each. 608 (set-buffer nnbabyl-mbox-buffer)
529 (while spools 609 (goto-char (point-min))
530 (and 610 (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t)
531 (file-exists-p (car spools)) 611 (if (intern-soft (setq id (match-string 1)) idents)
532 (> (nth 7 (file-attributes (car spools))) 0) 612 (progn
533 (progn 613 (delete-region (progn (beginning-of-line) (point))
534 (and gnus-verbose-backends 614 (progn (forward-line 1) (point)))
535 (message "nnbabyl: Reading incoming mail...")) 615 (nnheader-message 7 "Moving %s..." id)
536 (if (not (setq incoming 616 (nnbabyl-save-mail))
537 (nnmail-move-inbox 617 (intern id idents)))
538 (car spools) 618 (when (buffer-modified-p (current-buffer))
539 (concat nnbabyl-mbox-file "-Incoming")))) 619 (save-buffer))
540 () 620 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
541 (setq incomings (cons incoming incomings)) 621 (message ""))))
542 (save-excursion
543 (setq group (nnmail-get-split-group (car spools) group-in))
544 (let* ((nnmail-prepare-incoming-hook
545 (cons 'nnbabyl-remove-incoming-delims
546 nnmail-prepare-incoming-hook))
547 in-buf)
548 (setq in-buf (nnmail-split-incoming
549 incoming 'nnbabyl-save-mail t group))
550 (set-buffer in-buf)
551 (goto-char (point-min))
552 (while (search-forward "\n\^_\n" nil t)
553 (delete-char -1))
554 (set-buffer nnbabyl-mbox-buffer)
555 (goto-char (point-max))
556 (search-backward "\n\^_" nil t)
557 (goto-char (match-end 0))
558 (insert-buffer-substring in-buf)
559 (kill-buffer in-buf))))))
560 (setq spools (cdr spools)))
561 ;; If we did indeed read any incoming spools, we save all info.
562 (and (buffer-modified-p nnbabyl-mbox-buffer)
563 (save-excursion
564 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
565 (set-buffer nnbabyl-mbox-buffer)
566 (save-buffer)))
567 (if incomings (run-hooks 'nnmail-read-incoming-hook))
568 (while incomings
569 (setq incoming (car incomings))
570 (and nnmail-delete-incoming
571 (file-exists-p incoming)
572 (file-writable-p incoming)
573 (delete-file incoming))
574 (setq incomings (cdr incomings))))))
575 622
576(provide 'nnbabyl) 623(provide 'nnbabyl)
577 624
diff --git a/lisp/nneething.el b/lisp/nneething.el
index 691c84f0ecc..bcf013fdf8b 100644
--- a/lisp/nneething.el
+++ b/lisp/nneething.el
@@ -95,7 +95,7 @@ If this variable is nil, no files will be excluded.")
95 95
96 (when (and (file-exists-p file) 96 (when (and (file-exists-p file)
97 (or (file-directory-p file) 97 (or (file-directory-p file)
98 (not (zerop (nth 7 (file-attributes file)))))) 98 (not (zerop (nnheader-file-size file)))))
99 (insert (format "221 %d Article retrieved.\n" article)) 99 (insert (format "221 %d Article retrieved.\n" article))
100 (nneething-insert-head file) 100 (nneething-insert-head file)
101 (insert ".\n")) 101 (insert ".\n"))
diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el
index 90c1396ff34..6ff058247b3 100644
--- a/lisp/nnfolder.el
+++ b/lisp/nnfolder.el
@@ -670,8 +670,9 @@ time saver for large mailboxes.")
670 (let ((delim (concat "^" message-unix-mail-delimiter)) 670 (let ((delim (concat "^" message-unix-mail-delimiter))
671 (marker (concat "\n" nnfolder-article-marker)) 671 (marker (concat "\n" nnfolder-article-marker))
672 (number "[0-9]+") 672 (number "[0-9]+")
673 (active (cadr (assoc nnfolder-current-group 673 (active (or (cadr (assoc nnfolder-current-group
674 nnfolder-group-alist))) 674 nnfolder-group-alist))
675 (cons 1 0)))
675 (scantime (assoc nnfolder-current-group nnfolder-scantime-alist)) 676 (scantime (assoc nnfolder-current-group nnfolder-scantime-alist))
676 (minid (lsh -1 -1)) 677 (minid (lsh -1 -1))
677 maxid start end newscantime) 678 maxid start end newscantime)
diff --git a/lisp/nnheader.el b/lisp/nnheader.el
index 3c6aaa9a509..1c93816dfb6 100644
--- a/lisp/nnheader.el
+++ b/lisp/nnheader.el
@@ -570,6 +570,40 @@ without formatting."
570 (while (re-search-forward "\r$" nil t) 570 (while (re-search-forward "\r$" nil t)
571 (delete-backward-char 1)))) 571 (delete-backward-char 1))))
572 572
573(defun nnheader-file-size (file)
574 "Return the file size of FILE or 0."
575 (or (nth 7 (file-attributes file)) 0))
576
577(defun nnheader-find-etc-directory (package)
578 "Go through the path and find the \".../etc/PACKAGE\" directory."
579 (let ((path load-path)
580 dir result)
581 ;; We try to find the dir by looking at the load path,
582 ;; stripping away the last component and adding "etc/".
583 (while path
584 (if (and (car path)
585 (file-exists-p
586 (setq dir (concat
587 (file-name-directory
588 (directory-file-name (car path)))
589 "etc/" package "/")))
590 (file-directory-p dir))
591 (setq result dir
592 path nil)
593 (setq path (cdr path))))
594 result))
595
596(defvar ange-ftp-path-format)
597(defvar efs-path-regexp)
598(defun nnheader-re-read-dir (path)
599 "Re-read directory PATH if PATH is on a remote system."
600 (if (boundp 'ange-ftp-path-format)
601 (when (string-match (car ange-ftp-path-format) path)
602 (ange-ftp-re-read-dir path))
603 (if (boundp 'efs-path-regexp)
604 (when (string-match efs-path-regexp path)
605 (efs-re-read-dir path)))))
606
573(fset 'nnheader-run-at-time 'run-at-time) 607(fset 'nnheader-run-at-time 'run-at-time)
574(fset 'nnheader-cancel-timer 'cancel-timer) 608(fset 'nnheader-cancel-timer 'cancel-timer)
575(fset 'nnheader-find-file-noselect 'find-file-noselect) 609(fset 'nnheader-find-file-noselect 'find-file-noselect)
diff --git a/lisp/nnmail.el b/lisp/nnmail.el
index caf0a7c0c30..d108d590dad 100644
--- a/lisp/nnmail.el
+++ b/lisp/nnmail.el
@@ -382,9 +382,9 @@ parameter. It should return nil, `warn' or `delete'.")
382 (substring inbox (+ popmail 3)))))) 382 (substring inbox (+ popmail 3))))))
383 (message "Getting mail from post office ...")) 383 (message "Getting mail from post office ..."))
384 (when (or (and (file-exists-p tofile) 384 (when (or (and (file-exists-p tofile)
385 (/= 0 (nth 7 (file-attributes tofile)))) 385 (/= 0 (nnheader-file-size tofile)))
386 (and (file-exists-p inbox) 386 (and (file-exists-p inbox)
387 (/= 0 (nth 7 (file-attributes inbox))))) 387 (/= 0 (nnheader-file-size inbox))))
388 (message "Getting mail from %s..." inbox))) 388 (message "Getting mail from %s..." inbox)))
389 ;; Set TOFILE if have not already done so, and 389 ;; Set TOFILE if have not already done so, and
390 ;; rename or copy the file INBOX to TOFILE if and as appropriate. 390 ;; rename or copy the file INBOX to TOFILE if and as appropriate.
@@ -923,8 +923,8 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
923 nnmail-procmail-suffix "$") t))) 923 nnmail-procmail-suffix "$") t)))
924 (p procmails) 924 (p procmails)
925 (crash (when (and (file-exists-p nnmail-crash-box) 925 (crash (when (and (file-exists-p nnmail-crash-box)
926 (> (nth 7 (file-attributes 926 (> (nnheader-file-size
927 (file-truename nnmail-crash-box))) 0)) 927 (file-truename nnmail-crash-box)) 0))
928 (list nnmail-crash-box)))) 928 (list nnmail-crash-box))))
929 ;; Remove any directories that inadvertantly match the procmail 929 ;; Remove any directories that inadvertantly match the procmail
930 ;; suffix, which might happen if the suffix is "". 930 ;; suffix, which might happen if the suffix is "".
@@ -937,8 +937,12 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
937 crash 937 crash
938 (cond ((and group 938 (cond ((and group
939 (or (eq nnmail-spool-file 'procmail) 939 (or (eq nnmail-spool-file 'procmail)
940 nnmail-use-procmail)) 940 nnmail-use-procmail)
941 procmails)
941 procmails) 942 procmails)
943 ((and group
944 (eq nnmail-spool-file 'procmail))
945 nil)
942 ((listp nnmail-spool-file) 946 ((listp nnmail-spool-file)
943 (append nnmail-spool-file procmails)) 947 (append nnmail-spool-file procmails))
944 ((stringp nnmail-spool-file) 948 ((stringp nnmail-spool-file)
@@ -1107,7 +1111,7 @@ See the documentation for the variable `nnmail-split-fancy' for documentation."
1107 ;; existance of POPped mail. 1111 ;; existance of POPped mail.
1108 (when (or (string-match "^po:" spool) 1112 (when (or (string-match "^po:" spool)
1109 (and (file-exists-p spool) 1113 (and (file-exists-p spool)
1110 (> (nth 7 (file-attributes (file-truename spool))) 0))) 1114 (> (nnheader-file-size (file-truename spool)) 0)))
1111 (nnheader-message 3 "%s: Reading incoming mail..." method) 1115 (nnheader-message 3 "%s: Reading incoming mail..." method)
1112 (when (and (nnmail-move-inbox spool) 1116 (when (and (nnmail-move-inbox spool)
1113 (file-exists-p nnmail-crash-box)) 1117 (file-exists-p nnmail-crash-box))
diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el
index 171463740db..9b7957247d4 100644
--- a/lisp/nnmbox.el
+++ b/lisp/nnmbox.el
@@ -484,7 +484,7 @@
484 (buffer-name nnmbox-mbox-buffer) 484 (buffer-name nnmbox-mbox-buffer)
485 (save-excursion 485 (save-excursion
486 (set-buffer nnmbox-mbox-buffer) 486 (set-buffer nnmbox-mbox-buffer)
487 (= (buffer-size) (nth 7 (file-attributes nnmbox-mbox-file))))) 487 (= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
488 () 488 ()
489 (save-excursion 489 (save-excursion
490 (let ((delim (concat "^" message-unix-mail-delimiter)) 490 (let ((delim (concat "^" message-unix-mail-delimiter))
diff --git a/lisp/nnmh.el b/lisp/nnmh.el
index bebc050effe..cc9adab8996 100644
--- a/lisp/nnmh.el
+++ b/lisp/nnmh.el
@@ -157,6 +157,8 @@
157 (nnheader-report 'nnmh "Selected group %s" group) 157 (nnheader-report 'nnmh "Selected group %s" group)
158 t) 158 t)
159 (t 159 (t
160 ;; Re-scan the directory if it's on a foreign system.
161 (nnheader-re-read-dir pathname)
160 (setq dir 162 (setq dir
161 (sort 163 (sort
162 (mapcar (lambda (name) (string-to-int name)) 164 (mapcar (lambda (name) (string-to-int name))
diff --git a/lisp/nnspool.el b/lisp/nnspool.el
index 82a607efe60..f80bf28b7cd 100644
--- a/lisp/nnspool.el
+++ b/lisp/nnspool.el
@@ -465,7 +465,7 @@ there.")
465 (buffer-disable-undo (current-buffer)) 465 (buffer-disable-undo (current-buffer))
466 (erase-buffer) 466 (erase-buffer)
467 (condition-case () 467 (condition-case ()
468 (call-process "grep" nil t nil id nnspool-history-file) 468 (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)
469 (error nil)) 469 (error nil))
470 (goto-char (point-min)) 470 (goto-char (point-min))
471 (prog1 471 (prog1