-(defun nntp-open-server (server &optional defs)
- (nnheader-init-server-buffer)
- (if (nntp-server-opened server)
- t
- (if (or (stringp (car defs))
- (numberp (car defs)))
- (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs))))
- (or (assq 'nntp-address defs)
- (setq defs (append defs (list (list 'nntp-address server)))))
- (if (and nntp-current-server
- (not (equal server nntp-current-server)))
- (setq nntp-server-alist
- (cons (list nntp-current-server
- (nnheader-save-variables nntp-server-variables))
- nntp-server-alist)))
- (let ((state (assoc server nntp-server-alist)))
- (if state
- (progn
- (nnheader-restore-variables (nth 1 state))
- (setq nntp-server-alist (delq state nntp-server-alist)))
- (nnheader-set-init-variables nntp-server-variables defs)))
- (setq nntp-current-server server)
- (or (nntp-server-opened server)
- (progn
- (if (member nntp-address nntp-timeout-servers)
- nil
- (run-hooks 'nntp-prepare-server-hook)
- (nntp-open-server-semi-internal nntp-address nntp-port-number))))))
-
-(defun nntp-close-server (&optional server)
- "Close connection to SERVER."
- (nntp-possibly-change-server nil server)
- (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.
- (if (nntp-server-opened)
- (nntp-send-command nil "QUIT")))
- (nntp-close-server-internal server)
- (setq nntp-timeout-servers (delete server nntp-timeout-servers))))
-
-(defalias 'nntp-request-quit (symbol-function 'nntp-close-server))
-
-(defun nntp-request-close ()
- "Close all server connections."
- (let (proc)
- (while nntp-opened-connections
- (setq proc (pop nntp-opened-connections))
- (and proc (delete-process proc)))
- (and nntp-async-buffer
- (get-buffer nntp-async-buffer)
- (kill-buffer nntp-async-buffer))
- (while nntp-server-alist
- (and (setq proc (nth 1 (assq 'nntp-async-buffer
- (car nntp-server-alist))))
- (buffer-name proc)
- (kill-buffer proc))
- (setq nntp-server-alist (cdr nntp-server-alist)))
- (setq nntp-current-server nil
- nntp-timeout-servers nil
- nntp-async-group-alist nil)))
-
-(defun nntp-server-opened (&optional server)
- "Say whether a connection to SERVER has been opened."
- (and (equal server nntp-current-server)
- nntp-server-buffer
- (buffer-name nntp-server-buffer)
- nntp-server-process
- (memq (process-status nntp-server-process) '(open run))))
-
-(defun 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 "")))
-
-(defun nntp-request-article (id &optional newsgroup server buffer)
- "Request article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup server)
-
- (let (found)
-
- ;; First we see whether we can get the article from the async buffer.
- (if (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)
- (if (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))))
- (progn
- (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)
- (and nntp-async-articles
- (nntp-async-fetch-articles id)))))))
-
- (if found
- t
- ;; 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)))
- ;; If NEmacs, end of message may look like: "\256\215" (".^M")
- (prog1
- (nntp-send-command "^\\.\r?\n" "ARTICLE" art)
- (nntp-decode-text)
- (and nntp-async-articles (nntp-async-fetch-articles id)))))
- (if buffer (set-process-buffer
- nntp-server-process nntp-server-buffer))))))
-
-(defun nntp-request-body (id &optional newsgroup server)
- "Request body of article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup 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)))
-
-(defun nntp-request-head (id &optional newsgroup server)
- "Request head of article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup server)
- (prog1
- (nntp-send-command
- "^\\.\r?\n" "HEAD" (or (and (numberp id) (int-to-string id)) id))
- (nntp-decode-text)))
-
-(defun nntp-request-stat (id &optional newsgroup server)
- "Request STAT of article ID (message-id or number)."
- (nntp-possibly-change-server newsgroup server)
- (nntp-send-command
- "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id)))
-
-(defun nntp-request-group (group &optional server dont-check)
- "Select GROUP."
- (nntp-send-command "^.*\r?\n" "GROUP" group)
- (setq nntp-current-group group)