(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.")
(defvoo nntp-telnet-command "telnet"
"*Telnet command used to connect to the nntp server.
This command is used by the methods `nntp-open-telnet-stream',
-`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.
-
-See `nntp-netcat-command' for the `nntp-open-via-rlogin-and-netcat'
-method.")
+`nntp-open-via-rlogin-and-telnet' and `nntp-open-via-telnet-and-telnet'.")
(defvoo nntp-telnet-switches '("-8")
"*Switches given to the telnet command `nntp-telnet-command'.")
-(defvoo nntp-netcat-command "nc"
- "*Netcat command used to connect to the nntp server.
-This command is used by the `nntp-open-via-rlogin-and-netcat' method.")
-
-(defvoo nntp-netcat-switches nil
- "*Switches given to the netcat command `nntp-netcat-command'.")
-
(defvoo nntp-end-of-line "\r\n"
"*String to use on the end of lines when talking to the NNTP server.
-This is \"\\r\\n\" by default, but should be \"\\n\" when
-using and indirect connection method (nntp-open-via-*).")
+This is \"\\r\\n\" by default, but should be \"\\n\" when using and
+indirect telnet connection method (nntp-open-via-*-and-telnet).")
(defvoo nntp-via-rlogin-command "rsh"
"*Rlogin command used to connect to an intermediate host.
(defvoo nntp-via-telnet-switches '("-8")
"*Switches given to the telnet command `nntp-via-telnet-command'.")
+(defvoo nntp-via-netcat-command "nc"
+ "*Netcat command used to connect to the nntp server.
+This command is used by the `nntp-open-via-rlogin-and-netcat' method.")
+
+(defvoo nntp-via-netcat-switches nil
+ "*Switches given to the netcat command `nntp-via-netcat-command'.")
+
(defvoo nntp-via-user-name nil
"*User name to log in on an intermediate host with.
This variable is used by the various nntp-open-via-* methods.")
(defvoo nntp-warn-about-losing-connection t
"*If non-nil, beep when a server closes connection.")
+;; Marks
+(defvoo nntp-marks-is-evil nil
+ "*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")
+(defvoo nntp-marks nil)
+(defvar nntp-marks-modtime (gnus-make-hashtable))
+
+(defcustom nntp-marks-directory
+ (nnheader-concat gnus-directory "marks/")
+ "*The directory where marks for nntp groups will be stored."
+ :group 'gnus
+ :type 'directory)
+
(defcustom nntp-authinfo-file "~/.authinfo"
".netrc-like file that holds nntp authinfo passwords."
+ :group 'nntp
:type
'(choice file
(repeat :tag "Entries"
(deffoo nntp-asynchronous-p ()
t)
+(deffoo nntp-request-set-mark (group actions &optional server)
+ (unless nntp-marks-is-evil
+ (nntp-possibly-create-directory group server)
+ (nntp-open-marks group server)
+ (dolist (action actions)
+ (let ((range (nth 0 action))
+ (what (nth 1 action))
+ (marks (nth 2 action)))
+ (assert (or (eq what 'add) (eq what 'del)) nil
+ "Unknown request-set-mark action: %s" what)
+ (dolist (mark marks)
+ (setq nntp-marks (gnus-update-alist-soft
+ mark
+ (funcall (if (eq what 'add) 'gnus-range-add
+ 'gnus-remove-from-range)
+ (cdr (assoc mark nntp-marks)) range)
+ nntp-marks)))))
+ (nntp-save-marks group server))
+ nil)
+
+(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)
+
+
+
;;; Hooky functions.
(defun nntp-send-mode-reader ()
If SEND-IF-FORCE, only send authinfo to the server if the
.authinfo file has the FORCE token."
- (let* ((list (gnus-parse-netrc nntp-authinfo-file))
- (alist (gnus-netrc-machine list nntp-address "nntp"))
- (force (gnus-netrc-get alist "force"))
- (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
- (passwd (gnus-netrc-get alist "password")))
+ (let* ((list (netrc-parse nntp-authinfo-file))
+ (alist (netrc-machine list nntp-address "nntp"))
+ (force (netrc-get alist "force"))
+ (user (or (netrc-get alist "login") nntp-authinfo-user))
+ (passwd (netrc-get alist "password")))
(when (or (not send-if-force)
force)
(unless user
"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))))
- `nntp-via-rlogin-command-switches',
- `nntp-via-user-name',
- `nntp-via-address',
-- `nntp-netcat-command',
-- `nntp-netcat-switches',
+- `nntp-via-netcat-command',
+- `nntp-via-netcat-switches',
- `nntp-address',
- `nntp-port-number',
- `nntp-end-of-line'."
,@(when nntp-via-user-name
(list "-l" nntp-via-user-name))
,nntp-via-address
- ,nntp-netcat-command
- ,@nntp-netcat-switches
+ ,nntp-via-netcat-command
+ ,@nntp-via-netcat-switches
,nntp-address
,nntp-port-number)))
(apply 'start-process "nntpd" buffer command)))
(delete-region (point) (point-max)))
proc)))
+;; Marks handling
+
+(defun nntp-marks-directory (server)
+ (expand-file-name server nntp-marks-directory))
+
+(defun nntp-possibly-create-directory (group server)
+ (let ((dir (nnmail-group-pathname
+ group (nntp-marks-directory server))))
+ (unless (file-exists-p dir)
+ (make-directory (directory-file-name dir) t)
+ (nnheader-message 5 "Creating nntp marks directory %s" dir))))
+
+(defun nntp-marks-changed-p (group server)
+ (let ((file (expand-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)))))))
+
+(defun nntp-save-marks (group server)
+ (let ((file-name-coding-system nnmail-pathname-coding-system)
+ (file (expand-file-name
+ nntp-marks-file-name
+ (nnmail-group-pathname
+ group (nntp-marks-directory server)))))
+ (condition-case err
+ (progn
+ (nntp-possibly-create-directory group server)
+ (with-temp-file file
+ (erase-buffer)
+ (gnus-prin1 nntp-marks)
+ (insert "\n"))
+ (gnus-sethash file
+ (nth 5 (file-attributes file))
+ nntp-marks-modtime))
+ (error (or (gnus-yes-or-no-p
+ (format "Could not write to %s (%s). Continue? " file err))
+ (error "Cannot write to %s (%s)" file err))))))
+
+(defun nntp-open-marks (group server)
+ (let ((file (expand-file-name
+ nntp-marks-file-name
+ (nnmail-group-pathname
+ group (nntp-marks-directory server)))))
+ (if (file-exists-p file)
+ (condition-case err
+ (with-temp-buffer
+ (gnus-sethash file (nth 5 (file-attributes file))
+ nntp-marks-modtime)
+ (nnheader-insert-file-contents file)
+ (setq nntp-marks (read (current-buffer)))
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nntp-marks (gnus-remassoc el nntp-marks))))
+ (error (or (gnus-yes-or-no-p
+ (format "Error reading nntp marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
+ (error "Cannot read nntp marks file %s (%s)" file err))))
+ ;; User didn't have a .marks file. Probably first time
+ ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
+ (let ((info (gnus-get-info
+ (gnus-group-prefixed-name
+ group
+ (gnus-server-to-method (format "nntp:%s" server))))))
+ (nnheader-message 7 "Bootstrapping marks for %s..." group)
+ (setq nntp-marks (gnus-info-marks info))
+ (push (cons 'read (gnus-info-read info)) nntp-marks)
+ (dolist (el gnus-article-unpropagated-mark-lists)
+ (setq nntp-marks (gnus-remassoc el nntp-marks)))
+ (nntp-save-marks group server)
+ (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
+
(provide 'nntp)
;;; nntp.el ends here