-(deffoo nntp-open-server (server &optional defs connectionless)
- "Open the virtual server SERVER.
-If CONNECTIONLESS is non-nil, don't attempt to connect to any physical
-servers."
- ;; Called with just a port number as the defs.
- (when (or (stringp (car defs))
- (numberp (car defs)))
- (setq defs `((nntp-port-number ,(car defs)))))
- (unless (assq 'nntp-address defs)
- (setq defs (append defs `((nntp-address ,server)))))
- (nnoo-change-server 'nntp server defs)
- (if (nntp-server-opened server)
- t
- (or (nntp-server-opened server)
- connectionless
- (prog2
- (run-hooks 'nntp-prepare-server-hook)
- (nntp-open-server-semi-internal nntp-address nntp-port-number)
- (nnheader-insert "")))))
-
-(deffoo nntp-close-server (&optional server)
- "Close connection to SERVER."
- (nntp-possibly-change-server nil server t)
- (unwind-protect
- (progn
- ;; Un-set default sentinel function before closing connection.
- (and nntp-server-process
- (eq 'nntp-default-sentinel
- (process-sentinel nntp-server-process))
- (set-process-sentinel nntp-server-process nil))
- ;; We cannot send QUIT command unless the process is running.
- (when (nntp-server-opened server)
- (nntp-send-command nil "QUIT")
- ;; Give the QUIT time to arrive.
- (sleep-for 1)))
- (nntp-close-server-internal server)))
-
-(deffoo nntp-request-close ()
- "Close all server connections."
- (let (proc)
- (while nntp-opened-connections
- (when (setq proc (pop nntp-opened-connections))
- ;; Un-set default sentinel function before closing connection.
- (when (eq 'nntp-default-sentinel (process-sentinel proc))
- (set-process-sentinel proc nil))
- (condition-case ()
- (process-send-string proc (concat "QUIT" nntp-end-of-line))
- (error nil))
- ;; Give the QUIT time to reach the server before we close
- ;; down the process.
- (sleep-for 1)
- (delete-process proc)))
- (and nntp-async-buffer
- (buffer-name nntp-async-buffer)
- (kill-buffer nntp-async-buffer))
- (let ((alist (cddr (assq 'nntp nnoo-state-alist)))
- entry)
- (while (setq entry (pop alist))
- (and (setq proc (cdr (assq 'nntp-async-buffer entry)))
- (buffer-name proc)
- (kill-buffer proc))))
- (nnoo-close-server 'nntp)
- (setq nntp-async-group-alist nil)))
-
-(deffoo nntp-server-opened (&optional server)
- "Say whether a connection to SERVER has been opened."
- (and (nnoo-current-server-p 'nntp server)
- nntp-server-buffer
- (buffer-name nntp-server-buffer)
- nntp-server-process
- (memq (process-status nntp-server-process) '(open run))))
-
-(deffoo nntp-status-message (&optional server)
- "Return server status as a string."
- (if (and nntp-status-string
- ;; NNN MESSAGE
- (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
- nntp-status-string))
- (substring nntp-status-string (match-beginning 1) (match-end 1))
- ;; Empty message if nothing.
- (or nntp-status-string "")))
-
-(deffoo nntp-request-article (id &optional group server buffer)
- "Request article ID (Message-ID or number)."
- (nntp-possibly-change-server group server)
-
- (let (found)
-
- ;; First we see whether we can get the article from the async buffer.
- (when (and (numberp id)
- nntp-async-articles
- (memq id nntp-async-fetched))
- (save-excursion
- (set-buffer nntp-async-buffer)
- (let ((opoint (point))
- (art (if (numberp id) (int-to-string id) id))
- beg end)
- (when (and (or (re-search-forward (concat "^2.. +" art) nil t)
- (progn
- (goto-char (point-min))
- (re-search-forward (concat "^2.. +" art) opoint t)))
- (progn
- (beginning-of-line)
- (setq beg (point)
- end (re-search-forward "^\\.\r?\n" nil t))))
- (setq found t)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (insert-buffer-substring nntp-async-buffer beg end)
- (let ((nntp-server-buffer (current-buffer)))
- (nntp-decode-text)))
- (delete-region beg end)
- (when nntp-async-articles
- (nntp-async-fetch-articles id))))))
-
- (if found
- id
- ;; The article was not in the async buffer, so we fetch it now.
- (unwind-protect
- (progn
- (if buffer (set-process-buffer nntp-server-process buffer))
- (let ((nntp-server-buffer (or buffer nntp-server-buffer))
- (art (or (and (numberp id) (int-to-string id)) id)))
- (prog1
- (and (nntp-send-command
- ;; A bit odd regexp to ensure working over rlogin.
- "^\\.\r?\n" "ARTICLE" art)
- (if (numberp id)
- (cons nntp-current-group id)
- ;; We find out what the article number was.
- (nntp-find-group-and-number)))
- (nntp-decode-text)
- (and nntp-async-articles (nntp-async-fetch-articles id)))))
- (when buffer
- (set-process-buffer nntp-server-process nntp-server-buffer))))))
-
-(deffoo nntp-request-body (id &optional group server)
- "Request body of article ID (Message-ID or number)."
- (nntp-possibly-change-server group server)
- (prog1
- ;; If NEmacs, end of message may look like: "\256\215" (".^M")
- (nntp-send-command
- "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id))
- (nntp-decode-text)))
-
-(deffoo nntp-request-head (id &optional group server)
- "Request head of article ID (Message-ID or number)."
- (nntp-possibly-change-server group server)
- (prog1
- (when (nntp-send-command
- "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id))
- (if (numberp id) id
- ;; We find out what the article number was.
- (nntp-find-group-and-number)))
- (nntp-decode-text)))
-
-(deffoo nntp-request-stat (id &optional group server)
- "Request STAT of article ID (Message-ID or number)."
- (nntp-possibly-change-server group server)
- (nntp-send-command
- "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id)))
-
-(deffoo nntp-request-type (group &optional article)
- 'news)
-
-(deffoo nntp-request-group (group &optional server dont-check)
- "Select GROUP."
- (nntp-possibly-change-server nil server)
- (setq nntp-current-group
- (when (nntp-send-command "^2.*\r?\n" "GROUP" group)
- group)))
-
-(deffoo nntp-request-asynchronous (group &optional server articles)
- "Enable pre-fetch in GROUP."
- (when nntp-async-articles
- (nntp-async-request-group group))
- (when nntp-async-number
- (if (not (or (nntp-async-server-opened)
- (nntp-async-open-server)))
- ;; Couldn't open the second connection
- (progn
- (message "Can't open second connection to %s" nntp-address)
- (ding)
- (setq nntp-async-articles nil)
- (sit-for 2))
- ;; We opened the second connection (or it was opened already).
- (setq nntp-async-articles articles)
- (setq nntp-async-fetched nil)
- ;; Clear any old data.
- (save-excursion
- (set-buffer nntp-async-buffer)
- (erase-buffer))
- ;; Select the correct current group on this server.
- (nntp-async-send-strings "GROUP" group)
- t)))