-(defun nntp-request-list (&optional server)
- "List active groups."
- (nntp-possibly-change-server nil server)
- (prog1
- (nntp-send-command "^\\.\r$" "LIST")
- (nntp-decode-text)))
-
-(defun nntp-request-list-newsgroups (&optional server)
- "List groups."
- (nntp-possibly-change-server nil server)
- (prog1
- (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS")
- (nntp-decode-text)))
-
-(defun nntp-request-newgroups (date &optional server)
- "List new groups."
- (nntp-possibly-change-server nil server)
- (let* ((date (timezone-parse-date date))
- (time-string
- (format "%s%02d%02d %s%s%s"
- (substring (aref date 0) 2) (string-to-int (aref date 1))
- (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
- (substring
- (aref date 3) 3 5) (substring (aref date 3) 6 8))))
- (prog1
- (nntp-send-command "^\\.\r$" "NEWGROUPS" time-string)
- (nntp-decode-text))))
-
-(defun nntp-request-list-distributions (&optional server)
- "List distributions."
- (nntp-possibly-change-server nil server)
- (prog1
- (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS")
- (nntp-decode-text)))
-
-(defun nntp-request-last (&optional newsgroup server)
- "Decrease the current article pointer."
- (nntp-possibly-change-server newsgroup server)
- (nntp-send-command "^[23].*\r$" "LAST"))
-
-(defun nntp-request-next (&optional newsgroup server)
- "Advance the current article pointer."
- (nntp-possibly-change-server newsgroup server)
- (nntp-send-command "^[23].*\r$" "NEXT"))
-
-(defun nntp-request-post (&optional server)
- "Post the current buffer."
- (nntp-possibly-change-server nil server)
- (if (nntp-send-command "^[23].*\r$" "POST")
- (progn
- (nntp-encode-text)
- (nntp-send-region-to-server (point-min) (point-max))
- ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
- ;; appended to end of the status message.
- (nntp-wait-for-response "^[23].*$"))))
-
-(defun nntp-request-post-buffer
- (post group subject header article-buffer info follow-to respect-poster)
- "Request a buffer suitable for composing an article.
-If POST, this is an original article; otherwise it's a followup.
-GROUP is the group to be posted to, the article should have subject
-SUBJECT. HEADER is a Gnus header vector. ARTICLE-BUFFER contains the
-article being followed up. INFO is a Gnus info list. If FOLLOW-TO,
-post to this group instead. If RESPECT-POSTER, heed the special
-\"poster\" value of the Followup-to header."
- (if (assq 'to-address (nth 4 info))
- (nnmail-request-post-buffer
- post group subject header article-buffer info follow-to respect-poster)
- (let (from date to followup-to newsgroups message-of
- references distribution message-id)
- (save-excursion
- (set-buffer (get-buffer-create "*post-news*"))
- (news-reply-mode)
- (if (and (buffer-modified-p)
- (> (buffer-size) 0)
- (not (y-or-n-p "Unsent article being composed; erase it? ")))
- ()
- (erase-buffer)
- (if post
- (news-setup nil subject nil group nil)
- (save-excursion
- (set-buffer article-buffer)
- (goto-char (point-min))
- (narrow-to-region (point-min)
- (progn (search-forward "\n\n") (point)))
- (setq from (header-from header))
- (setq date (header-date header))
- (and from
- (let ((stop-pos
- (string-match " *at \\| *@ \\| *(\\| *<" from)))
- (setq
- message-of
- (concat (if stop-pos (substring from 0 stop-pos) from)
- "'s message of " date))))
- (setq subject (or subject (header-subject header)))
- (or (string-match "^[Rr][Ee]:" subject)
- (setq subject (concat "Re: " subject)))
- (setq followup-to (mail-fetch-field "followup-to"))
- (if (or (null respect-poster) ;Ignore followup-to: field.
- (string-equal "" followup-to) ;Bogus header.
- (string-equal "poster" followup-to)) ;Poster
- (setq followup-to nil))
- (setq newsgroups
- (or follow-to followup-to (mail-fetch-field "newsgroups")))
- (setq references (header-references header))
- (setq distribution (mail-fetch-field "distribution"))
- ;; Remove bogus distribution.
- (and (stringp distribution)
- (string-match "world" distribution)
- (setq distribution nil))
- (setq message-id (header-id header))
- (widen))
- (setq news-reply-yank-from from)
- (setq news-reply-yank-message-id message-id)
- (news-setup to subject message-of
- (if (stringp newsgroups) newsgroups "")
- article-buffer)
- (if (and newsgroups (listp newsgroups))
- (progn
- (goto-char (point-min))
- (while newsgroups
- (insert (car (car newsgroups)) ": "
- (cdr (car newsgroups)) "\n")
- (setq newsgroups (cdr newsgroups)))))
- ;; Fold long references line to follow RFC1036.
- (mail-position-on-field "References")
- (let ((begin (- (point) (length "References: ")))
- (fill-column 79)
- (fill-prefix "\t"))
- (if references (insert references))
- (if (and references message-id) (insert " "))
- (if message-id (insert message-id))
- ;; The region must end with a newline to fill the region
- ;; without inserting extra newline.
- (fill-region-as-paragraph begin (1+ (point))))
- (if distribution
- (progn
- (mail-position-on-field "Distribution")
- (insert distribution)))))
- (current-buffer)))))
-
-;;; Internal functions.