Mercurial > emacs
annotate lisp/gnus/nnmh.el @ 110422:93e093c035a0
Merge changes made in Gnus trunk.
nnimap.el (nnimap-request-group): Use the stored info for the dont-check case.
nnimap.el: Use deffoo instead of defun for interface functions.
gnus-int.el (gnus-request-group): Take an optional `info' parameter.
nnimap.el: Allow nnimap-request-group to do a complete marks sync on `M-g'.
nnimap.el: Get credentials for numerical equivalents of the port numbers.
gnus-html.el (gnus-html-wash-tags): Add support for i, b and u HTML tags.
nnimap.el (nnimap-update-info): Extend the info so that we can set the marks.
nnimap.el (nnimap-open-connection): Fix typo -- should be 'shell, not 'stream.
nnimap.el: Allow PREAUTH nnimap connections to log in without credentials.
nnimap.el (nnimap-update-info): Fix off-by-one error when concatenating ranges when doing a partial update.
gnus-html.el (gnus-html-schedule-image-fetching): Use `url' rather than curl to retrieve images.
nnimap.el (nnimap-update-info): When doing partial marks update, get the range update right.
nnimap.el (nnimap-wait-for-response): Be a bit more lax in finding the end of the command we're looking for.
nnimap.el: Allow sending \n instead of \r\n on 'shell streams.
gnus-html.el (gnus-html-schedule-image-fetching): Fetch all images in parallel.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Sat, 18 Sep 2010 23:36:29 +0000 |
parents | 6a6bf4529cad |
children | 415e87a42437 |
rev | line source |
---|---|
17493 | 1 ;;; nnmh.el --- mhspool access for Gnus |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
2 |
64754
fafd692d1e40
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, |
106815 | 4 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
17493 | 5 |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
6 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
7 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
17493 | 8 ;; Keywords: news, mail |
9 | |
10 ;; This file is part of GNU Emacs. | |
11 | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93386
diff
changeset
|
12 ;; GNU Emacs is free software: you can redistribute it and/or modify |
17493 | 13 ;; it under the terms of the GNU General Public License as published by |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93386
diff
changeset
|
14 ;; the Free Software Foundation, either version 3 of the License, or |
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93386
diff
changeset
|
15 ;; (at your option) any later version. |
17493 | 16 |
17 ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 ;; GNU General Public License for more details. | |
21 | |
22 ;; You should have received a copy of the GNU General Public License | |
94662
f42ef85caf91
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93386
diff
changeset
|
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
17493 | 24 |
25 ;;; Commentary: | |
26 | |
27 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>. | |
28 ;; For an overview of what the interface functions do, please see the | |
29 ;; Gnus sources. | |
30 | |
31 ;;; Code: | |
32 | |
33 (require 'nnheader) | |
34 (require 'nnmail) | |
35 (require 'gnus-start) | |
36 (require 'nnoo) | |
19494
4280cff25537
Require cl only at compile time.
Richard M. Stallman <rms@gnu.org>
parents:
17493
diff
changeset
|
37 (eval-when-compile (require 'cl)) |
17493 | 38 |
39 (nnoo-declare nnmh) | |
40 | |
41 (defvoo nnmh-directory message-directory | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
42 "Mail spool directory.") |
17493 | 43 |
44 (defvoo nnmh-get-new-mail t | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
45 "If non-nil, nnmh will check the incoming mail file and split the mail.") |
17493 | 46 |
47 (defvoo nnmh-prepare-save-mail-hook nil | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
48 "Hook run narrowed to an article before saving.") |
17493 | 49 |
50 (defvoo nnmh-be-safe nil | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
51 "If non-nil, nnmh will check all articles to make sure whether they are new or not. |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
52 Go through the .nnmh-articles file and compare with the actual |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
53 articles in this folder. The articles that are \"new\" will be marked |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
54 as unread by Gnus.") |
17493 | 55 |
56 | |
57 | |
58 (defconst nnmh-version "nnmh 1.0" | |
59 "nnmh version.") | |
60 | |
61 (defvoo nnmh-current-directory nil | |
62 "Current news group directory.") | |
63 | |
64 (defvoo nnmh-status-string "") | |
65 (defvoo nnmh-group-alist nil) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
66 ;; Don't even think about setting this variable. It does not exist. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
67 ;; Forget about it. Uh-huh. Nope. Nobody here. It's only bound |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
68 ;; dynamically by certain functions in nndraft. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
69 (defvar nnmh-allow-delete-final nil) |
17493 | 70 |
71 | |
72 | |
73 ;;; Interface functions. | |
74 | |
75 (nnoo-define-basics nnmh) | |
76 | |
77 (deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old) | |
92771
a3d61f1532f1
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
78 (with-current-buffer nntp-server-buffer |
17493 | 79 (erase-buffer) |
80 (let* ((file nil) | |
81 (number (length articles)) | |
82 (large (and (numberp nnmail-large-newsgroup) | |
83 (> number nnmail-large-newsgroup))) | |
84 (count 0) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
85 (file-name-coding-system nnmail-pathname-coding-system) |
17493 | 86 beg article) |
87 (nnmh-possibly-change-directory newsgroup server) | |
88 ;; We don't support fetching by Message-ID. | |
89 (if (stringp (car articles)) | |
90 'headers | |
91 (while articles | |
92 (when (and (file-exists-p | |
93 (setq file (concat (file-name-as-directory | |
94 nnmh-current-directory) | |
95 (int-to-string | |
96 (setq article (pop articles)))))) | |
97 (not (file-directory-p file))) | |
98 (insert (format "221 %d Article retrieved.\n" article)) | |
99 (setq beg (point)) | |
100 (nnheader-insert-head file) | |
101 (goto-char beg) | |
102 (if (search-forward "\n\n" nil t) | |
103 (forward-char -1) | |
104 (goto-char (point-max)) | |
105 (insert "\n\n")) | |
106 (insert ".\n") | |
107 (delete-region (point) (point-max))) | |
108 (setq count (1+ count)) | |
109 | |
110 (and large | |
111 (zerop (% count 20)) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
112 (nnheader-message 5 "nnmh: Receiving headers... %d%%" |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
113 (/ (* count 100) number)))) |
17493 | 114 |
115 (when large | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
116 (nnheader-message 5 "nnmh: Receiving headers...done")) |
17493 | 117 |
118 (nnheader-fold-continuation-lines) | |
119 'headers)))) | |
120 | |
121 (deffoo nnmh-open-server (server &optional defs) | |
122 (nnoo-change-server 'nnmh server defs) | |
123 (when (not (file-exists-p nnmh-directory)) | |
124 (condition-case () | |
125 (make-directory nnmh-directory t) | |
126 (error t))) | |
127 (cond | |
128 ((not (file-exists-p nnmh-directory)) | |
129 (nnmh-close-server) | |
130 (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory)) | |
131 ((not (file-directory-p (file-truename nnmh-directory))) | |
132 (nnmh-close-server) | |
133 (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory)) | |
134 (t | |
135 (nnheader-report 'nnmh "Opened server %s using directory %s" | |
136 server nnmh-directory) | |
137 t))) | |
138 | |
139 (deffoo nnmh-request-article (id &optional newsgroup server buffer) | |
140 (nnmh-possibly-change-directory newsgroup server) | |
141 (let ((file (if (stringp id) | |
142 nil | |
143 (concat nnmh-current-directory (int-to-string id)))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
144 (file-name-coding-system nnmail-pathname-coding-system) |
17493 | 145 (nntp-server-buffer (or buffer nntp-server-buffer))) |
146 (and (stringp file) | |
147 (file-exists-p file) | |
148 (not (file-directory-p file)) | |
149 (save-excursion (nnmail-find-file file)) | |
62907
88db2adda4b7
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-339
Miles Bader <miles@gnu.org>
parents:
56927
diff
changeset
|
150 (string-to-number (file-name-nondirectory file))))) |
17493 | 151 |
110422
93e093c035a0
Merge changes made in Gnus trunk.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110202
diff
changeset
|
152 (deffoo nnmh-request-group (group &optional server dont-check info) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
153 (nnheader-init-server-buffer) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
154 (nnmh-possibly-change-directory group server) |
17493 | 155 (let ((pathname (nnmail-group-pathname group nnmh-directory)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
156 (file-name-coding-system nnmail-pathname-coding-system) |
17493 | 157 dir) |
158 (cond | |
159 ((not (file-directory-p pathname)) | |
160 (nnheader-report | |
161 'nnmh "Can't select group (no such directory): %s" group)) | |
162 (t | |
163 (setq nnmh-current-directory pathname) | |
164 (and nnmh-get-new-mail | |
165 nnmh-be-safe | |
166 (nnmh-update-gnus-unreads group)) | |
167 (cond | |
168 (dont-check | |
169 (nnheader-report 'nnmh "Selected group %s" group) | |
170 t) | |
171 (t | |
172 ;; Re-scan the directory if it's on a foreign system. | |
173 (nnheader-re-read-dir pathname) | |
174 (setq dir | |
175 (sort | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
176 (mapcar 'string-to-number |
17493 | 177 (directory-files pathname nil "^[0-9]+$" t)) |
178 '<)) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
179 (cond |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
180 (dir |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
181 (setq nnmh-group-alist |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
182 (delq (assoc group nnmh-group-alist) nnmh-group-alist)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
183 (push (list group (cons (car dir) (car (last dir)))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
184 nnmh-group-alist) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
185 (nnheader-report 'nnmh "Selected group %s" group) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
186 (nnheader-insert |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
187 "211 %d %d %d %s\n" (length dir) (car dir) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
188 (car (last dir)) group)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
189 (t |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
190 (nnheader-report 'nnmh "Empty group %s" group) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
191 (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) |
17493 | 192 |
193 (deffoo nnmh-request-scan (&optional group server) | |
194 (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) | |
195 | |
196 (deffoo nnmh-request-list (&optional server dir) | |
197 (nnheader-insert "") | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
198 (nnmh-possibly-change-directory nil server) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
199 (let ((file-name-coding-system nnmail-pathname-coding-system) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
200 (nnmh-toplev |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
201 (file-truename (or dir (file-name-as-directory nnmh-directory))))) |
17493 | 202 (nnmh-request-list-1 nnmh-toplev)) |
203 (setq nnmh-group-alist (nnmail-get-active)) | |
204 t) | |
205 | |
206 (defvar nnmh-toplev) | |
207 (defun nnmh-request-list-1 (dir) | |
208 (setq dir (expand-file-name dir)) | |
209 ;; Recurse down all directories. | |
110171
a05bc4ad2d3f
mm-util.el: Just return the image directories, not all directories in the path in addition to the image directories; Maintain a cache of the image directories. This means that the `g' command in Gnus doesn't have to stat dozens of directories each time; nnmh.el: Only recurse down into subdirectories if the link count is more than 2. This results in a 100x speed up on my nnmh spool, and that's from an SSD disk, and not over nfs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110111
diff
changeset
|
210 (let ((files (nnheader-directory-files dir t nil t)) |
a05bc4ad2d3f
mm-util.el: Just return the image directories, not all directories in the path in addition to the image directories; Maintain a cache of the image directories. This means that the `g' command in Gnus doesn't have to stat dozens of directories each time; nnmh.el: Only recurse down into subdirectories if the link count is more than 2. This results in a 100x speed up on my nnmh spool, and that's from an SSD disk, and not over nfs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110111
diff
changeset
|
211 (max 0) |
110202
6a6bf4529cad
(nnmh-request-list-1): Bind `file'.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110191
diff
changeset
|
212 min rdir num subdirectoriesp file) |
17493 | 213 ;; Recurse down directories. |
110189
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
214 (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2)) |
110171
a05bc4ad2d3f
mm-util.el: Just return the image directories, not all directories in the path in addition to the image directories; Maintain a cache of the image directories. This means that the `g' command in Gnus doesn't have to stat dozens of directories each time; nnmh.el: Only recurse down into subdirectories if the link count is more than 2. This results in a 100x speed up on my nnmh spool, and that's from an SSD disk, and not over nfs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110111
diff
changeset
|
215 (dolist (rdir files) |
110189
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
216 (if (or (not subdirectoriesp) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
217 (file-regular-p rdir)) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
218 (progn |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
219 (setq file (file-name-nondirectory rdir)) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
220 (when (string-match "^[0-9]+$" file) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
221 (setq num (string-to-number file)) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
222 (setq max (max max num)) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
223 (when (or (null min) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
224 (< num min)) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
225 (setq min num)))) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
226 ;; This is a directory. |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
227 (when (and (file-readable-p rdir) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
228 (not (equal (file-truename rdir) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
229 (file-truename dir)))) |
821c596efa5f
Rewrite the Gnus group activation method to be more efficient; nnmh.el (nnmh-request-list-1): Fix up the recursion behavior; Add more changes related to the new methodology for requesting backend data.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110171
diff
changeset
|
230 (nnmh-request-list-1 rdir)))) |
110171
a05bc4ad2d3f
mm-util.el: Just return the image directories, not all directories in the path in addition to the image directories; Maintain a cache of the image directories. This means that the `g' command in Gnus doesn't have to stat dozens of directories each time; nnmh.el: Only recurse down into subdirectories if the link count is more than 2. This results in a 100x speed up on my nnmh spool, and that's from an SSD disk, and not over nfs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110111
diff
changeset
|
231 ;; For each directory, generate an active file line. |
a05bc4ad2d3f
mm-util.el: Just return the image directories, not all directories in the path in addition to the image directories; Maintain a cache of the image directories. This means that the `g' command in Gnus doesn't have to stat dozens of directories each time; nnmh.el: Only recurse down into subdirectories if the link count is more than 2. This results in a 100x speed up on my nnmh spool, and that's from an SSD disk, and not over nfs.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110111
diff
changeset
|
232 (unless (string= (expand-file-name nnmh-toplev) dir) |
110190
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
233 (with-current-buffer nntp-server-buffer |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
234 (goto-char (point-max)) |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
235 (insert |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
236 (format |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
237 "%s %.0f %.0f y\n" |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
238 (progn |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
239 (string-match |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
240 (regexp-quote |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
241 (file-truename (file-name-as-directory |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
242 (expand-file-name nnmh-toplev)))) |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
243 dir) |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
244 (mm-string-to-multibyte ;Why? Isn't it multibyte already? |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
245 (mm-encode-coding-string |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
246 (nnheader-replace-chars-in-string |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
247 (substring dir (match-end 0)) |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
248 ?/ ?.) |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
249 nnmail-pathname-coding-system))) |
896692b6eb7b
nnmh.el (nnmh-request-list-1): Output active lines also for empty directories. This makes the draft queue directory work.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110189
diff
changeset
|
250 (or max 0) |
110191
1e69e141b6a0
gnus-agent.el (gnus-agent-load-local): Only read the agent.lib/local file once per `g' run.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110190
diff
changeset
|
251 (or min 1)))))) |
17493 | 252 t) |
253 | |
254 (deffoo nnmh-request-newgroups (date &optional server) | |
255 (nnmh-request-list server)) | |
256 | |
257 (deffoo nnmh-request-expire-articles (articles newsgroup | |
258 &optional server force) | |
259 (nnmh-possibly-change-directory newsgroup server) | |
93386 | 260 (let ((is-old t) |
261 (nnmail-expiry-target | |
262 (or (gnus-group-find-parameter newsgroup 'expiry-target t) | |
263 nnmail-expiry-target)) | |
264 article rest mod-time) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
265 (nnheader-init-server-buffer) |
17493 | 266 |
267 (while (and articles is-old) | |
268 (setq article (concat nnmh-current-directory | |
269 (int-to-string (car articles)))) | |
270 (when (setq mod-time (nth 5 (file-attributes article))) | |
271 (if (and (nnmh-deletable-article-p newsgroup (car articles)) | |
272 (setq is-old | |
273 (nnmail-expired-article-p newsgroup mod-time force))) | |
274 (progn | |
47002
b87254142b98
* nnfolder.el (nnfolder-request-expire-articles): expiry-target.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
46966
diff
changeset
|
275 ;; Allow a special target group. -- jcn |
b87254142b98
* nnfolder.el (nnfolder-request-expire-articles): expiry-target.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
46966
diff
changeset
|
276 (unless (eq nnmail-expiry-target 'delete) |
b87254142b98
* nnfolder.el (nnfolder-request-expire-articles): expiry-target.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
46966
diff
changeset
|
277 (with-temp-buffer |
b87254142b98
* nnfolder.el (nnfolder-request-expire-articles): expiry-target.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
46966
diff
changeset
|
278 (nnmh-request-article (car articles) |
b87254142b98
* nnfolder.el (nnfolder-request-expire-articles): expiry-target.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
46966
diff
changeset
|
279 newsgroup server (current-buffer)) |
b87254142b98
* nnfolder.el (nnfolder-request-expire-articles): expiry-target.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
46966
diff
changeset
|
280 (nnmail-expiry-target-group |
b87254142b98
* nnfolder.el (nnfolder-request-expire-articles): expiry-target.
ShengHuo ZHU <zsh@cs.rochester.edu>
parents:
46966
diff
changeset
|
281 nnmail-expiry-target newsgroup))) |
17493 | 282 (nnheader-message 5 "Deleting article %s in %s..." |
283 article newsgroup) | |
284 (condition-case () | |
285 (funcall nnmail-delete-file-function article) | |
286 (file-error | |
287 (nnheader-message 1 "Couldn't delete article %s in %s" | |
288 article newsgroup) | |
289 (push (car articles) rest)))) | |
290 (push (car articles) rest))) | |
291 (setq articles (cdr articles))) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
292 (nnheader-message 5 "") |
17493 | 293 (nconc rest articles))) |
294 | |
295 (deffoo nnmh-close-group (group &optional server) | |
296 t) | |
297 | |
110111
5b9f64b04a04
Delete all trailing white space.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
298 (deffoo nnmh-request-move-article (article group server accept-form |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
299 &optional last move-is-internal) |
17493 | 300 (let ((buf (get-buffer-create " *nnmh move*")) |
301 result) | |
302 (and | |
303 (nnmh-deletable-article-p group article) | |
304 (nnmh-request-article article group server) | |
92771
a3d61f1532f1
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
305 (with-current-buffer buf |
17493 | 306 (erase-buffer) |
307 (insert-buffer-substring nntp-server-buffer) | |
308 (setq result (eval accept-form)) | |
309 (kill-buffer (current-buffer)) | |
310 result) | |
311 (progn | |
312 (nnmh-possibly-change-directory group server) | |
313 (condition-case () | |
314 (funcall nnmail-delete-file-function | |
315 (concat nnmh-current-directory (int-to-string article))) | |
316 (file-error nil)))) | |
317 result)) | |
318 | |
319 (deffoo nnmh-request-accept-article (group &optional server last noinsert) | |
320 (nnmh-possibly-change-directory group server) | |
321 (nnmail-check-syntax) | |
322 (when nnmail-cache-accepted-message-ids | |
110111
5b9f64b04a04
Delete all trailing white space.
Katsumi Yamaoka <yamaoka@jpl.org>
parents:
110102
diff
changeset
|
323 (nnmail-cache-insert (nnmail-fetch-field "message-id") |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
324 group |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
325 (nnmail-fetch-field "subject") |
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
326 (nnmail-fetch-field "from"))) |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
327 (nnheader-init-server-buffer) |
17493 | 328 (prog1 |
329 (if (stringp group) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
330 (if noinsert |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
331 (nnmh-active-number group) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
332 (car (nnmh-save-mail |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
333 (list (cons group (nnmh-active-number group))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
334 noinsert))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
335 (let ((res (nnmail-article-group 'nnmh-active-number))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
336 (if (and (null res) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
337 (yes-or-no-p "Moved to `junk' group; delete article? ")) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
338 'junk |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
339 (car (nnmh-save-mail res noinsert))))) |
17493 | 340 (when (and last nnmail-cache-accepted-message-ids) |
341 (nnmail-cache-close)))) | |
342 | |
343 (deffoo nnmh-request-replace-article (article group buffer) | |
344 (nnmh-possibly-change-directory group) | |
92771
a3d61f1532f1
Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87649
diff
changeset
|
345 (with-current-buffer buffer |
17493 | 346 (nnmh-possibly-create-directory group) |
347 (ignore-errors | |
348 (nnmail-write-region | |
349 (point-min) (point-max) | |
350 (concat nnmh-current-directory (int-to-string article)) | |
351 nil (if (nnheader-be-verbose 5) nil 'nomesg)) | |
352 t))) | |
353 | |
354 (deffoo nnmh-request-create-group (group &optional server args) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
355 (nnheader-init-server-buffer) |
17493 | 356 (unless (assoc group nnmh-group-alist) |
357 (let (active) | |
358 (push (list group (setq active (cons 1 0))) | |
359 nnmh-group-alist) | |
360 (nnmh-possibly-create-directory group) | |
361 (nnmh-possibly-change-directory group server) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
362 (let ((articles (mapcar 'string-to-number |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
363 (directory-files |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
364 nnmh-current-directory nil "^[0-9]+$")))) |
17493 | 365 (when articles |
366 (setcar active (apply 'min articles)) | |
367 (setcdr active (apply 'max articles)))))) | |
368 t) | |
369 | |
370 (deffoo nnmh-request-delete-group (group &optional force server) | |
371 (nnmh-possibly-change-directory group server) | |
372 ;; Delete all articles in GROUP. | |
373 (if (not force) | |
374 () ; Don't delete the articles. | |
375 (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) | |
376 (while articles | |
377 (when (file-writable-p (car articles)) | |
378 (nnheader-message 5 "Deleting article %s in %s..." | |
379 (car articles) group) | |
380 (funcall nnmail-delete-file-function (car articles))) | |
381 (setq articles (cdr articles)))) | |
382 ;; Try to delete the directory itself. | |
383 (ignore-errors | |
384 (delete-directory nnmh-current-directory))) | |
385 ;; Remove the group from all structures. | |
386 (setq nnmh-group-alist | |
387 (delq (assoc group nnmh-group-alist) nnmh-group-alist) | |
388 nnmh-current-directory nil) | |
389 t) | |
390 | |
391 (deffoo nnmh-request-rename-group (group new-name &optional server) | |
392 (nnmh-possibly-change-directory group server) | |
393 (let ((new-dir (nnmail-group-pathname new-name nnmh-directory)) | |
394 (old-dir (nnmail-group-pathname group nnmh-directory))) | |
395 (when (ignore-errors | |
396 (make-directory new-dir t) | |
397 t) | |
398 ;; We move the articles file by file instead of renaming | |
399 ;; the directory -- there may be subgroups in this group. | |
400 ;; One might be more clever, I guess. | |
401 (let ((files (nnheader-article-to-file-alist old-dir))) | |
402 (while files | |
403 (rename-file | |
404 (concat old-dir (cdar files)) | |
405 (concat new-dir (cdar files))) | |
406 (pop files))) | |
407 (when (<= (length (directory-files old-dir)) 2) | |
408 (ignore-errors | |
409 (delete-directory old-dir))) | |
410 ;; That went ok, so we change the internal structures. | |
411 (let ((entry (assoc group nnmh-group-alist))) | |
412 (when entry | |
413 (setcar entry new-name)) | |
414 (setq nnmh-current-directory nil) | |
415 t)))) | |
416 | |
417 (nnoo-define-skeleton nnmh) | |
418 | |
419 | |
420 ;;; Internal functions. | |
421 | |
422 (defun nnmh-possibly-change-directory (newsgroup &optional server) | |
423 (when (and server | |
424 (not (nnmh-server-opened server))) | |
425 (nnmh-open-server server)) | |
426 (when newsgroup | |
19602
549f21ee4bf0
(nnmh-request-list, nnmh-active-number): Protect from
Kenichi Handa <handa@m17n.org>
parents:
19494
diff
changeset
|
427 (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
428 (file-name-coding-system nnmail-pathname-coding-system)) |
17493 | 429 (if (file-directory-p pathname) |
430 (setq nnmh-current-directory pathname) | |
56927
55fd4f77387a
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Miles Bader <miles@gnu.org>
parents:
52401
diff
changeset
|
431 (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory))))) |
17493 | 432 |
433 (defun nnmh-possibly-create-directory (group) | |
434 (let (dir dirs) | |
435 (setq dir (nnmail-group-pathname group nnmh-directory)) | |
436 (while (not (file-directory-p dir)) | |
437 (push dir dirs) | |
438 (setq dir (file-name-directory (directory-file-name dir)))) | |
439 (while dirs | |
440 (when (make-directory (directory-file-name (car dirs))) | |
441 (error "Could not create directory %s" (car dirs))) | |
442 (nnheader-message 5 "Creating mail directory %s" (car dirs)) | |
443 (setq dirs (cdr dirs))))) | |
444 | |
445 (defun nnmh-save-mail (group-art &optional noinsert) | |
446 "Called narrowed to an article." | |
447 (unless noinsert | |
448 (nnmail-insert-lines) | |
449 (nnmail-insert-xref group-art)) | |
450 (run-hooks 'nnmail-prepare-save-mail-hook) | |
451 (run-hooks 'nnmh-prepare-save-mail-hook) | |
452 (goto-char (point-min)) | |
453 (while (looking-at "From ") | |
454 (replace-match "X-From-Line: ") | |
455 (forward-line 1)) | |
456 ;; We save the article in all the newsgroups it belongs in. | |
457 (let ((ga group-art) | |
458 first) | |
459 (while ga | |
460 (nnmh-possibly-create-directory (caar ga)) | |
461 (let ((file (concat (nnmail-group-pathname | |
462 (caar ga) nnmh-directory) | |
463 (int-to-string (cdar ga))))) | |
464 (if first | |
465 ;; It was already saved, so we just make a hard link. | |
466 (funcall nnmail-crosspost-link-function first file t) | |
467 ;; Save the article. | |
468 (nnmail-write-region (point-min) (point-max) file nil nil) | |
469 (setq first file))) | |
470 (setq ga (cdr ga)))) | |
471 group-art) | |
472 | |
473 (defun nnmh-active-number (group) | |
474 "Compute the next article number in GROUP." | |
475 (let ((active (cadr (assoc group nnmh-group-alist))) | |
19602
549f21ee4bf0
(nnmh-request-list, nnmh-active-number): Protect from
Kenichi Handa <handa@m17n.org>
parents:
19494
diff
changeset
|
476 (dir (nnmail-group-pathname group nnmh-directory)) |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
477 (file-name-coding-system nnmail-pathname-coding-system) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
478 file) |
17493 | 479 (unless active |
480 ;; The group wasn't known to nnmh, so we just create an active | |
481 ;; entry for it. | |
482 (setq active (cons 1 0)) | |
483 (push (list group active) nnmh-group-alist) | |
484 (unless (file-exists-p dir) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
485 (gnus-make-directory dir)) |
17493 | 486 ;; Find the highest number in the group. |
487 (let ((files (sort | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
488 (mapcar 'string-to-number |
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
489 (directory-files dir nil "^[0-9]+$")) |
17493 | 490 '>))) |
491 (when files | |
492 (setcdr active (car files))))) | |
493 (setcdr active (1+ (cdr active))) | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
494 (while (or |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
495 ;; See whether the file exists... |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
496 (file-exists-p |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
497 (setq file (concat (nnmail-group-pathname group nnmh-directory) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
498 (int-to-string (cdr active))))) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
499 ;; ... or there is a buffer that will make that file exist |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
500 ;; in the future. |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
501 (get-file-buffer file)) |
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
502 ;; Skip past that file. |
17493 | 503 (setcdr active (1+ (cdr active)))) |
504 (cdr active))) | |
505 | |
506 (defun nnmh-update-gnus-unreads (group) | |
507 ;; Go through the .nnmh-articles file and compare with the actual | |
508 ;; articles in this folder. The articles that are "new" will be | |
509 ;; marked as unread by Gnus. | |
510 (let* ((dir nnmh-current-directory) | |
85712
a3c27999decb
Update Gnus to No Gnus 0.7 from the Gnus CVS trunk
Miles Bader <miles@gnu.org>
parents:
78224
diff
changeset
|
511 (files (sort (mapcar 'string-to-number |
17493 | 512 (directory-files nnmh-current-directory |
513 nil "^[0-9]+$" t)) | |
514 '<)) | |
515 (nnmh-file (concat dir ".nnmh-articles")) | |
516 new articles) | |
517 ;; Load the .nnmh-articles file. | |
518 (when (file-exists-p nnmh-file) | |
519 (setq articles | |
520 (let (nnmh-newsgroup-articles) | |
521 (ignore-errors (load nnmh-file nil t t)) | |
522 nnmh-newsgroup-articles))) | |
523 ;; Add all new articles to the `new' list. | |
524 (let ((art files)) | |
525 (while art | |
526 (unless (assq (car art) articles) | |
527 (push (car art) new)) | |
528 (setq art (cdr art)))) | |
529 ;; Remove all deleted articles. | |
530 (let ((art articles)) | |
531 (while art | |
532 (unless (memq (caar art) files) | |
533 (setq articles (delq (car art) articles))) | |
534 (setq art (cdr art)))) | |
535 ;; Check whether the articles really are the ones that Gnus thinks | |
536 ;; they are by looking at the time-stamps. | |
537 (let ((arts articles) | |
538 art) | |
539 (while (setq art (pop arts)) | |
540 (when (not (equal | |
541 (nth 5 (file-attributes | |
542 (concat dir (int-to-string (car art))))) | |
543 (cdr art))) | |
544 (setq articles (delq art articles)) | |
545 (push (car art) new)))) | |
546 ;; Go through all the new articles and add them, and their | |
547 ;; time-stamps, to the list. | |
548 (setq articles | |
549 (nconc articles | |
550 (mapcar | |
551 (lambda (art) | |
552 (cons art | |
553 (nth 5 (file-attributes | |
554 (concat dir (int-to-string art)))))) | |
555 new))) | |
556 ;; Make Gnus mark all new articles as unread. | |
557 (when new | |
558 (gnus-make-articles-unread | |
559 (gnus-group-prefixed-name group (list 'nnmh "")) | |
560 (setq new (sort new '<)))) | |
561 ;; Sort the article list with highest numbers first. | |
562 (setq articles (sort articles (lambda (art1 art2) | |
563 (> (car art1) (car art2))))) | |
564 ;; Finally write this list back to the .nnmh-articles file. | |
31716
9968f55ad26e
Update to emacs-21-branch of the Gnus CVS repository.
Gerd Moellmann <gerd@gnu.org>
parents:
24357
diff
changeset
|
565 (with-temp-file nnmh-file |
17493 | 566 (insert ";; Gnus article active file for " group "\n\n") |
567 (insert "(setq nnmh-newsgroup-articles '") | |
568 (gnus-prin1 articles) | |
569 (insert ")\n")))) | |
570 | |
571 (defun nnmh-deletable-article-p (group article) | |
572 "Say whether ARTICLE in GROUP can be deleted." | |
573 (let ((path (concat nnmh-current-directory (int-to-string article)))) | |
574 ;; Writable. | |
575 (and (file-writable-p path) | |
24357
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
576 (or |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
577 ;; We can never delete the last article in the group. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
578 (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
579 article)) |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
580 ;; Well, we can. |
15fc6acbae7a
Upgrading to Gnus 5.7; see ChangeLog
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
19995
diff
changeset
|
581 nnmh-allow-delete-final)))) |
17493 | 582 |
583 (provide 'nnmh) | |
584 | |
585 ;;; nnmh.el ends here |