Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnspool.el @ 98:0d2f883870bc r20-1b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b1
author cvs
date Mon, 13 Aug 2007 09:13:56 +0200
parents 131b0175ea99
children 360340f9fd5f
comparison
equal deleted inserted replaced
97:498bf5da1c90 98:0d2f883870bc
1 ;;; nnspool.el --- spool access for GNU Emacs 1 ;;; nnspool.el --- spool access for GNU Emacs
2 ;; Copyright (C) 1988,89,90,93,94,95,96 Free Software Foundation, Inc. 2 ;; Copyright (C) 1988,89,90,93,94,95,96,97 Free Software Foundation, Inc.
3 3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news 6 ;; Keywords: news
7 7
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 (and 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
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)))
292 seconds)) 292 seconds))
293 (setq groups (cons (buffer-substring 293 (push (buffer-substring
294 (match-beginning 1) (match-end 1)) 294 (match-beginning 1) (match-end 1))
295 groups)) 295 groups)
296 (zerop (forward-line -1)))) 296 (zerop (forward-line -1))))
297 (erase-buffer) 297 (erase-buffer)
298 (while groups 298 (while groups
299 (insert (car groups) " 0 0 y\n") 299 (insert (car groups) " 0 0 y\n")
300 (setq groups (cdr groups)))) 300 (setq groups (cdr groups))))
318 (nnheader-report 'nnspool "") 318 (nnheader-report 'nnspool "")
319 (set-process-sentinel proc 'nnspool-inews-sentinel) 319 (set-process-sentinel proc 'nnspool-inews-sentinel)
320 (process-send-region proc (point-min) (point-max)) 320 (process-send-region proc (point-min) (point-max))
321 ;; We slap a condition-case around this, because the process may 321 ;; We slap a condition-case around this, because the process may
322 ;; have exited already... 322 ;; have exited already...
323 (condition-case nil 323 (ignore-errors
324 (process-send-eof proc) 324 (process-send-eof proc))
325 (error nil))
326 t)))) 325 t))))
327 326
328 327
329 328
330 ;;; Internal functions. 329 ;;; Internal functions.
356 (save-excursion 355 (save-excursion
357 (set-buffer nntp-server-buffer) 356 (set-buffer nntp-server-buffer)
358 (erase-buffer) 357 (erase-buffer)
359 (if nnspool-sift-nov-with-sed 358 (if nnspool-sift-nov-with-sed
360 (nnspool-sift-nov-with-sed articles nov) 359 (nnspool-sift-nov-with-sed articles nov)
361 (insert-file-contents nov) 360 (nnheader-insert-file-contents nov)
362 (if (and fetch-old 361 (if (and fetch-old
363 (not (numberp fetch-old))) 362 (not (numberp fetch-old)))
364 t ; We want all the headers. 363 t ; We want all the headers.
365 (condition-case () 364 (ignore-errors
366 (progn 365 ;; Delete unwanted NOV lines.
367 ;; First we find the first wanted line. 366 (nnheader-nov-delete-outside-range
368 (nnspool-find-nov-line 367 (if fetch-old (max 1 (- (car articles) fetch-old))
369 (if fetch-old (max 1 (- (car articles) fetch-old)) 368 (car articles))
370 (car articles))) 369 (car (last articles)))
371 (delete-region (point-min) (point)) 370 ;; If the buffer is empty, this wasn't very successful.
372 ;; Then we find the last wanted line. 371 (unless (zerop (buffer-size))
373 (if (nnspool-find-nov-line 372 ;; We check what the last article number was.
374 (progn (while (cdr articles) 373 ;; The NOV file may be out of sync with the articles
375 (setq articles (cdr articles))) 374 ;; in the group.
376 (car articles))) 375 (forward-line -1)
377 (forward-line 1)) 376 (setq last (read (current-buffer)))
378 (delete-region (point) (point-max)) 377 (if (= last (car articles))
379 ;; If the buffer is empty, this wasn't very successful. 378 ;; Yup, it's all there.
380 (unless (zerop (buffer-size)) 379 t
381 ;; We check what the last article number was. 380 ;; Perhaps not. We try to find the missing articles.
382 ;; The NOV file may be out of sync with the articles 381 (while (and arts
383 ;; in the group. 382 (<= last (car arts)))
384 (forward-line -1) 383 (pop arts))
385 (setq last (read (current-buffer))) 384 ;; The articles in `arts' are missing from the buffer.
386 (if (= last (car articles)) 385 (while arts
387 ;; Yup, it's all there. 386 (nnspool-insert-nov-head (pop arts)))
388 t 387 t))))))))))
389 ;; Perhaps not. We try to find the missing articles.
390 (while (and arts
391 (<= last (car arts)))
392 (pop arts))
393 ;; The articles in `arts' are missing from the buffer.
394 (while arts
395 (nnspool-insert-nov-head (pop arts)))
396 t)))
397 ;; The NOV file was corrupted.
398 (error nil)))))))))
399 388
400 (defun nnspool-insert-nov-head (article) 389 (defun nnspool-insert-nov-head (article)
401 "Read the head of ARTICLE, convert to NOV headers, and insert." 390 "Read the head of ARTICLE, convert to NOV headers, and insert."
402 (save-excursion 391 (save-excursion
403 (let ((cur (current-buffer)) 392 (let ((cur (current-buffer))
410 (set-buffer cur) 399 (set-buffer cur)
411 (goto-char (point-max)) 400 (goto-char (point-max))
412 (nnheader-insert-nov headers))) 401 (nnheader-insert-nov headers)))
413 (kill-buffer buf)))) 402 (kill-buffer buf))))
414 403
415 (defun nnspool-find-nov-line (article)
416 (let ((max (point-max))
417 (min (goto-char (point-min)))
418 (cur (current-buffer))
419 (prev (point-min))
420 num found)
421 (while (not found)
422 (goto-char (/ (+ max min) 2))
423 (beginning-of-line)
424 (if (or (= (point) prev)
425 (eobp))
426 (setq found t)
427 (setq prev (point))
428 (cond ((> (setq num (read cur)) article)
429 (setq max (point)))
430 ((< num article)
431 (setq min (point)))
432 (t
433 (setq found 'yes)))))
434 ;; Now we may have found the article we're looking for, or we
435 ;; may be somewhere near it.
436 (when (and (not (eq found 'yes))
437 (not (eq num article)))
438 (setq found (point))
439 (while (and (< (point) max)
440 (or (not (numberp num))
441 (< num article)))
442 (forward-line 1)
443 (setq found (point))
444 (or (eobp)
445 (= (setq num (read cur)) article)))
446 (unless (eq num article)
447 (goto-char found)))
448 (beginning-of-line)
449 (eq num article)))
450
451 (defun nnspool-sift-nov-with-sed (articles file) 404 (defun nnspool-sift-nov-with-sed (articles file)
452 (let ((first (car articles)) 405 (let ((first (car articles))
453 (last (progn (while (cdr articles) (setq articles (cdr articles))) 406 (last (progn (while (cdr articles) (setq articles (cdr articles)))
454 (car articles)))) 407 (car articles))))
455 (call-process "awk" nil t nil 408 (call-process "awk" nil t nil
462 (defun nnspool-find-id (id) 415 (defun nnspool-find-id (id)
463 (save-excursion 416 (save-excursion
464 (set-buffer (get-buffer-create " *nnspool work*")) 417 (set-buffer (get-buffer-create " *nnspool work*"))
465 (buffer-disable-undo (current-buffer)) 418 (buffer-disable-undo (current-buffer))
466 (erase-buffer) 419 (erase-buffer)
467 (condition-case () 420 (ignore-errors
468 (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file) 421 (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file))
469 (error nil))
470 (goto-char (point-min)) 422 (goto-char (point-min))
471 (prog1 423 (prog1
472 (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") 424 (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]")
473 (cons (match-string 1) (string-to-int (match-string 2)))) 425 (cons (match-string 1) (string-to-int (match-string 2))))
474 (kill-buffer (current-buffer))))) 426 (kill-buffer (current-buffer)))))
475 427
476 (defun nnspool-find-file (file) 428 (defun nnspool-find-file (file)
477 "Insert FILE in server buffer safely." 429 "Insert FILE in server buffer safely."
478 (set-buffer nntp-server-buffer) 430 (set-buffer nntp-server-buffer)
479 (erase-buffer) 431 (erase-buffer)
480 (condition-case () 432 (condition-case ()
481 (progn (nnheader-insert-file-contents-literally file) t) 433 (progn (nnheader-insert-file-contents file) t)
482 (file-error nil))) 434 (file-error nil)))
483 435
484 (defun nnspool-possibly-change-directory (group) 436 (defun nnspool-possibly-change-directory (group)
485 (if (not group) 437 (if (not group)
486 t 438 t
499 (timezone-parse-date date))) 451 (timezone-parse-date date)))
500 (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) 452 (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
501 (timezone-parse-time 453 (timezone-parse-time
502 (aref (timezone-parse-date date) 3)))) 454 (aref (timezone-parse-date date) 3))))
503 (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime) 455 (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime)
504 (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) 456 (nth 2 tdate) (nth 1 tdate) (nth 0 tdate)
505 (nth 4 tdate)))) 457 (nth 4 tdate))))
506 (+ (* (car unix) 65536.0) 458 (+ (* (car unix) 65536.0)
507 (cadr unix)))) 459 (cadr unix))))
508 460
509 (provide 'nnspool) 461 (provide 'nnspool)