Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnspool.el @ 108:360340f9fd5f r20-1b6

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b6
author cvs
date Mon, 13 Aug 2007 09:18:39 +0200
parents 0d2f883870bc
children
comparison
equal deleted inserted replaced
107:523141596bda 108:360340f9fd5f
117 ;; No NOV headers here, so we do it the hard way. 117 ;; No NOV headers here, so we do it the hard way.
118 (while (setq article (pop articles)) 118 (while (setq article (pop articles))
119 (if (stringp article) 119 (if (stringp article)
120 ;; This is a Message-ID. 120 ;; This is a Message-ID.
121 (setq ag (nnspool-find-id article) 121 (setq ag (nnspool-find-id article)
122 file (and ag (nnspool-article-pathname 122 file (and ag (nnspool-article-pathname
123 (car ag) (cdr ag))) 123 (car ag) (cdr ag)))
124 article (cdr ag)) 124 article (cdr ag))
125 ;; This is an article in the current group. 125 ;; This is an article in the current group.
126 (setq file (int-to-string article))) 126 (setq file (int-to-string article)))
127 ;; Insert the head of the article. 127 ;; Insert the head of the article.
135 (goto-char beg) 135 (goto-char beg)
136 (search-forward "\n\n" nil t) 136 (search-forward "\n\n" nil t)
137 (forward-char -1) 137 (forward-char -1)
138 (insert ".\n") 138 (insert ".\n")
139 (delete-region (point) (point-max))) 139 (delete-region (point) (point-max)))
140 140
141 (and do-message 141 (and do-message
142 (zerop (% (incf count) 20)) 142 (zerop (% (incf count) 20))
143 (message "nnspool: Receiving headers... %d%%" 143 (message "nnspool: Receiving headers... %d%%"
144 (/ (* count 100) number)))) 144 (/ (* count 100) number))))
145 145
146 (when do-message 146 (when do-message
147 (message "nnspool: Receiving headers...done")) 147 (message "nnspool: Receiving headers...done"))
148 148
149 ;; Fold continuation lines. 149 ;; Fold continuation lines.
150 (nnheader-fold-continuation-lines) 150 (nnheader-fold-continuation-lines)
151 'headers))))) 151 'headers)))))
152 152
153 (deffoo nnspool-open-server (server &optional defs) 153 (deffoo nnspool-open-server (server &optional defs)
154 (nnoo-change-server 'nnspool server defs) 154 (nnoo-change-server 'nnspool server defs)
155 (cond 155 (cond
156 ((not (file-exists-p nnspool-spool-directory)) 156 ((not (file-exists-p nnspool-spool-directory))
157 (nnspool-close-server) 157 (nnspool-close-server)
158 (nnheader-report 'nnspool "Spool directory doesn't exist: %s" 158 (nnheader-report 'nnspool "Spool directory doesn't exist: %s"
159 nnspool-spool-directory)) 159 nnspool-spool-directory))
160 ((not (file-directory-p 160 ((not (file-directory-p
161 (directory-file-name 161 (directory-file-name
162 (file-truename nnspool-spool-directory)))) 162 (file-truename nnspool-spool-directory))))
163 (nnspool-close-server) 163 (nnspool-close-server)
164 (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) 164 (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory))
165 ((not (file-exists-p nnspool-active-file)) 165 ((not (file-exists-p nnspool-active-file))
166 (nnheader-report 'nnspool "The active file doesn't exist: %s" 166 (nnheader-report 'nnspool "The active file doesn't exist: %s"
167 nnspool-active-file)) 167 nnspool-active-file))
168 (t 168 (t
169 (nnheader-report 'nnspool "Opened server %s using directory %s" 169 (nnheader-report 'nnspool "Opened server %s using directory %s"
170 server nnspool-spool-directory) 170 server nnspool-spool-directory)
171 t))) 171 t)))
174 "Select article by message ID (or number)." 174 "Select article by message ID (or number)."
175 (nnspool-possibly-change-directory group) 175 (nnspool-possibly-change-directory group)
176 (let ((nntp-server-buffer (or buffer nntp-server-buffer)) 176 (let ((nntp-server-buffer (or buffer nntp-server-buffer))
177 file ag) 177 file ag)
178 (if (stringp id) 178 (if (stringp id)
179 ;; This is a Message-ID. 179 ;; This is a Message-ID.
180 (when (setq ag (nnspool-find-id id)) 180 (when (setq ag (nnspool-find-id id))
181 (setq file (nnspool-article-pathname (car ag) (cdr ag)))) 181 (setq file (nnspool-article-pathname (car ag) (cdr ag))))
182 (setq file (nnspool-article-pathname nnspool-current-group id))) 182 (setq file (nnspool-article-pathname nnspool-current-group id)))
183 (and file 183 (and file
184 (file-exists-p file) 184 (file-exists-p file)
186 (save-excursion (nnspool-find-file file)) 186 (save-excursion (nnspool-find-file file))
187 ;; We return the article number and group name. 187 ;; We return the article number and group name.
188 (if (numberp id) 188 (if (numberp id)
189 (cons nnspool-current-group id) 189 (cons nnspool-current-group id)
190 ag)))) 190 ag))))
191 191
192 (deffoo nnspool-request-body (id &optional group server) 192 (deffoo nnspool-request-body (id &optional group server)
193 "Select article body by message ID (or number)." 193 "Select article body by message ID (or number)."
194 (nnspool-possibly-change-directory group) 194 (nnspool-possibly-change-directory group)
195 (let ((res (nnspool-request-article id))) 195 (let ((res (nnspool-request-article id)))
196 (when res 196 (when res
217 (deffoo nnspool-request-group (group &optional server dont-check) 217 (deffoo nnspool-request-group (group &optional server dont-check)
218 "Select news GROUP." 218 "Select news GROUP."
219 (let ((pathname (nnspool-article-pathname group)) 219 (let ((pathname (nnspool-article-pathname group))
220 dir) 220 dir)
221 (if (not (file-directory-p pathname)) 221 (if (not (file-directory-p pathname))
222 (nnheader-report 222 (nnheader-report
223 'nnspool "Invalid group name (no such directory): %s" group) 223 'nnspool "Invalid group name (no such directory): %s" group)
224 (setq nnspool-current-directory pathname) 224 (setq nnspool-current-directory pathname)
225 (nnheader-report 'nnspool "Selected group %s" group) 225 (nnheader-report 'nnspool "Selected group %s" group)
226 (if dont-check 226 (if dont-check
227 (progn 227 (progn
228 (nnheader-report 'nnspool "Selected group %s" group) 228 (nnheader-report 'nnspool "Selected group %s" group)
229 t) 229 t)
230 ;; Yes, completely empty spool directories *are* possible. 230 ;; Yes, completely empty spool directories *are* possible.
231 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> 231 ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
232 (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) 232 (when (setq dir (directory-files pathname nil "^[0-9]+$" t))
233 (setq dir 233 (setq dir
234 (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) 234 (sort (mapcar (lambda (name) (string-to-int name)) dir) '<)))
235 (if dir 235 (if dir
236 (nnheader-insert 236 (nnheader-insert
237 "211 %d %d %d %s\n" (length dir) (car dir) 237 "211 %d %d %d %s\n" (length dir) (car dir)
238 (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) 238 (progn (while (cdr dir) (setq dir (cdr dir))) (car dir))
254 254
255 (deffoo nnspool-request-list-newsgroups (&optional server) 255 (deffoo nnspool-request-list-newsgroups (&optional server)
256 "List newsgroups (defined in NNTP2)." 256 "List newsgroups (defined in NNTP2)."
257 (save-excursion 257 (save-excursion
258 (or (nnspool-find-file nnspool-newsgroups-file) 258 (or (nnspool-find-file nnspool-newsgroups-file)
259 (nnheader-report 'nnspool (nnheader-file-error 259 (nnheader-report 'nnspool (nnheader-file-error
260 nnspool-newsgroups-file))))) 260 nnspool-newsgroups-file)))))
261 261
262 (deffoo nnspool-request-list-distributions (&optional server) 262 (deffoo nnspool-request-list-distributions (&optional server)
263 "List distributions (defined in NNTP2)." 263 "List distributions (defined in NNTP2)."
264 (save-excursion 264 (save-excursion
265 (or (nnspool-find-file nnspool-distributions-file) 265 (or (nnspool-find-file nnspool-distributions-file)
266 (nnheader-report 'nnspool (nnheader-file-error 266 (nnheader-report 'nnspool (nnheader-file-error
267 nnspool-distributions-file))))) 267 nnspool-distributions-file)))))
268 268
269 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. 269 ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
270 (deffoo nnspool-request-newgroups (date &optional server) 270 (deffoo nnspool-request-newgroups (date &optional server)
271 "List groups created after DATE." 271 "List groups created after DATE."
272 (if (nnspool-find-file nnspool-active-times-file) 272 (if (nnspool-find-file nnspool-active-times-file)
273 (save-excursion 273 (save-excursion
274 ;; Find the last valid line. 274 ;; Find the last valid line.
275 (goto-char (point-max)) 275 (goto-char (point-max))
276 (while (and (not (looking-at 276 (while (and (not (looking-at
277 "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) 277 "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] "))
278 (zerop (forward-line -1)))) 278 (zerop (forward-line -1))))
279 (let ((seconds (nnspool-seconds-since-epoch date)) 279 (let ((seconds (nnspool-seconds-since-epoch date))
280 groups) 280 groups)
281 ;; Go through lines and add the latest groups to a list. 281 ;; Go through lines and add the latest groups to a list.
282 (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") 282 (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ")
283 (progn 283 (progn
284 ;; We insert a .0 to make the list reader 284 ;; We insert a .0 to make the list reader
285 ;; interpret the number as a float. It is far 285 ;; interpret the number as a float. It is far
286 ;; too big to be stored in a lisp integer. 286 ;; too big to be stored in a lisp integer.
287 (goto-char (1- (match-end 0))) 287 (goto-char (1- (match-end 0)))
288 (insert ".0") 288 (insert ".0")
289 (> (progn 289 (> (progn
290 (goto-char (match-end 1)) 290 (goto-char (match-end 1))
291 (read (current-buffer))) 291 (read (current-buffer)))
304 (deffoo nnspool-request-post (&optional server) 304 (deffoo nnspool-request-post (&optional server)
305 "Post a new news in current buffer." 305 "Post a new news in current buffer."
306 (save-excursion 306 (save-excursion
307 (let* ((process-connection-type nil) ; t bugs out on Solaris 307 (let* ((process-connection-type nil) ; t bugs out on Solaris
308 (inews-buffer (generate-new-buffer " *nnspool post*")) 308 (inews-buffer (generate-new-buffer " *nnspool post*"))
309 (proc 309 (proc
310 (condition-case err 310 (condition-case err
311 (apply 'start-process "*nnspool inews*" inews-buffer 311 (apply 'start-process "*nnspool inews*" inews-buffer
312 nnspool-inews-program nnspool-inews-switches) 312 nnspool-inews-program nnspool-inews-switches)
313 (error 313 (error
314 (nnheader-report 'nnspool "inews error: %S" err))))) 314 (nnheader-report 'nnspool "inews error: %S" err)))))
344 (run-hooks 'nnspool-rejected-article-hook)))) 344 (run-hooks 'nnspool-rejected-article-hook))))
345 345
346 (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) 346 (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old)
347 (if (or gnus-nov-is-evil nnspool-nov-is-evil) 347 (if (or gnus-nov-is-evil nnspool-nov-is-evil)
348 nil 348 nil
349 (let ((nov (nnheader-group-pathname 349 (let ((nov (nnheader-group-pathname
350 nnspool-current-group nnspool-nov-directory ".overview")) 350 nnspool-current-group nnspool-nov-directory ".overview"))
351 (arts articles) 351 (arts articles)
352 last) 352 last)
353 (if (not (file-exists-p nov)) 353 (if (not (file-exists-p nov))
354 () 354 ()
367 (if fetch-old (max 1 (- (car articles) fetch-old)) 367 (if fetch-old (max 1 (- (car articles) fetch-old))
368 (car articles)) 368 (car articles))
369 (car (last articles))) 369 (car (last articles)))
370 ;; If the buffer is empty, this wasn't very successful. 370 ;; If the buffer is empty, this wasn't very successful.
371 (unless (zerop (buffer-size)) 371 (unless (zerop (buffer-size))
372 ;; We check what the last article number was. 372 ;; We check what the last article number was.
373 ;; The NOV file may be out of sync with the articles 373 ;; The NOV file may be out of sync with the articles
374 ;; in the group. 374 ;; in the group.
375 (forward-line -1) 375 (forward-line -1)
376 (setq last (read (current-buffer))) 376 (setq last (read (current-buffer)))
377 (if (= last (car articles)) 377 (if (= last (car articles))
403 403
404 (defun nnspool-sift-nov-with-sed (articles file) 404 (defun nnspool-sift-nov-with-sed (articles file)
405 (let ((first (car articles)) 405 (let ((first (car articles))
406 (last (progn (while (cdr articles) (setq articles (cdr articles))) 406 (last (progn (while (cdr articles) (setq articles (cdr articles)))
407 (car articles)))) 407 (car articles))))
408 (call-process "awk" nil t nil 408 (call-process "awk" nil t nil
409 (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" 409 (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
410 (1- first) (1+ last)) 410 (1- first) (1+ last))
411 file))) 411 file)))
412 412
413 ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). 413 ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle).
414 ;; Find out what group an article identified by a Message-ID is in. 414 ;; Find out what group an article identified by a Message-ID is in.
415 (defun nnspool-find-id (id) 415 (defun nnspool-find-id (id)
416 (save-excursion 416 (save-excursion
417 (set-buffer (get-buffer-create " *nnspool work*")) 417 (set-buffer (get-buffer-create " *nnspool work*"))
418 (buffer-disable-undo (current-buffer)) 418 (buffer-disable-undo (current-buffer))