;;; nntp.el --- nntp access for Gnus
;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994, 1995, 1996,
-;; 1997, 1998, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
+;; 1997, 1998, 2000, 2001, 2002, 2003, 2004, 2005
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Katsumi Yamaoka <yamaoka@jpl.org>
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
+;; MA 02110-1301, USA.
;;; Commentary:
(require 'nnheader)
(require 'nnoo)
(require 'gnus-util)
+(require 'gnus)
(nnoo-declare nntp)
+(defgroup nntp nil
+ "NNTP access for Gnus."
+ :group 'gnus)
+
(defvoo nntp-address nil
"Address of the physical nntp server.")
;; Marks
(defvoo nntp-marks-is-evil nil
- "*If non-nil, GNus will never generate and use marks file for nntp groups.
+ "*If non-nil, Gnus will never generate and use marks file for nntp groups.
See `nnml-marks-is-evil' for more information.")
(defvoo nntp-marks-file-name ".marks")
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
+ :group 'nntp
:type
'(choice file
(repeat :tag "Entries"
;; a line with only a "." on it.
((eq (char-after) ?2)
(if (re-search-forward "\n\\.\r?\n" nil t)
- t
+ (progn
+ ;; Some broken news servers add another dot at the end.
+ ;; Protect against inflooping there.
+ (while (looking-at "^\\.\r?\n")
+ (forward-line 1))
+ t)
nil))
;; A result that starts with a 3xx or 4xx code is terminated
;; by a newline.
(condition-case nil
(progn ,@forms)
(quit
- (nntp-close-server)
+ (unless debug-on-quit
+ (nntp-close-server))
(signal 'quit nil))))
(when timer
(nnheader-cancel-timer timer)))
(deffoo nntp-request-update-info (group info &optional server)
(unless nntp-marks-is-evil
- (nntp-possibly-create-directory group server))
- (when (and (not nntp-marks-is-evil) (nntp-marks-changed-p group server))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nntp-open-marks group server)
- ;; Update info using `nntp-marks'.
- (mapc (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nntp-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nntp-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
+ (nntp-possibly-create-directory group server)
+ (when (nntp-marks-changed-p group server)
+ (nnheader-message 8 "Updating marks for %s..." group)
+ (nntp-open-marks group server)
+ ;; Update info using `nntp-marks'.
+ (mapc (lambda (pred)
+ (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
+ (gnus-info-set-marks
+ info
+ (gnus-update-alist-soft
+ (cdr pred)
+ (cdr (assq (cdr pred) nntp-marks))
+ (gnus-info-marks info))
+ t)))
+ gnus-article-mark-lists)
+ (let ((seen (cdr (assq 'read nntp-marks))))
+ (gnus-info-set-read info
+ (if (and (integerp (car seen))
+ (null (cdr seen)))
+ (list (cons (car seen) (car seen)))
+ seen)))
+ (nnheader-message 8 "Updating marks for %s...done" group)))
+ nil)
(nntp-kill-buffer pbuffer))
(when (and (buffer-name pbuffer)
process)
- (process-kill-without-query process)
+ (gnus-set-process-query-on-exit-flag process nil)
(if (and (nntp-wait-for process "^2.*\n" buffer nil t)
(memq (process-status process) '(open run)))
(prog1
(open-network-stream-as-binary
"nntpd" buffer nntp-address nntp-port-number))
-(autoload 'format-spec "format")
-(autoload 'format-spec-make "format")
-(autoload 'open-tls-stream "tls")
+(eval-and-compile
+ (autoload 'format-spec "format-spec")
+ (autoload 'format-spec-make "format-spec")
+ (autoload 'open-tls-stream "tls"))
(defun nntp-open-ssl-stream (buffer)
(let* ((process-connection-type nil)
(format-spec-make
?s nntp-address
?p nntp-port-number))))))
- (process-kill-without-query proc)
+ (gnus-set-process-query-on-exit-flag proc nil)
(save-excursion
(set-buffer buffer)
(let ((nntp-connection-alist (list proc buffer nil)))
(defun nntp-open-tls-stream (buffer)
(let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
- (process-kill-without-query proc)
+ (gnus-set-process-query-on-exit-flag proc nil)
(save-excursion
(set-buffer buffer)
(let ((nntp-connection-alist (list proc buffer nil)))
"Find out what the name of the server we have connected to is."
;; Wait for the status string to arrive.
(setq nntp-server-type (buffer-string))
- (let ((alist nntp-server-action-alist)
- (case-fold-search t)
- entry)
+ (let ((case-fold-search t))
;; Run server-specific commands.
- (while alist
- (setq entry (pop alist))
+ (dolist (entry nntp-server-action-alist)
(when (string-match (car entry) nntp-server-type)
(if (and (listp (cadr entry))
(not (eq 'lambda (caadr entry))))
(when (<= count 1)
(goto-char (point-min))
(when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
- (let ((low-limit (string-to-int
+ (let ((low-limit (string-to-number
(buffer-substring (match-beginning 1)
(match-end 1)))))
(while (and articles (<= (car articles) low-limit))
(goto-char (point-min))
;; We first find the number by looking at the status line.
(let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
- (string-to-int
+ (string-to-number
(buffer-substring (match-beginning 1)
(match-end 1)))))
newsgroups xref)
"\\([^ :]+\\):\\([0-9]+\\)")
xref))
(setq group (match-string 1 xref)
- number (string-to-int (match-string 2 xref))))
+ number (string-to-number (match-string 2 xref))))
((and (setq newsgroups
(mail-fetch-field "newsgroups"))
(not (string-match "," newsgroups)))
(make-directory (directory-file-name dir) t)
(nnheader-message 5 "Creating nntp marks directory %s" dir))))
+(eval-and-compile
+ (autoload 'time-less-p "time-date"))
+
(defun nntp-marks-changed-p (group server)
(let ((file (expand-file-name
- nntp-marks-file-name
+ nntp-marks-file-name
(nnmail-group-pathname
group (nntp-marks-directory server)))))
(if (null (gnus-gethash file nntp-marks-modtime))
t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nntp-marks-modtime)
- (nth 5 (file-attributes file)))))))
+ (time-less-p (gnus-gethash file nntp-marks-modtime)
+ (nth 5 (file-attributes file))))))
(defun nntp-save-marks (group server)
(let ((file-name-coding-system nnmail-pathname-coding-system)
projects / elisp / gnus.git- / blobdiff