-(defun gnus-news-group-p (group &optional article)
- "Return non-nil if GROUP (and ARTICLE) come from a news server."
- (or (gnus-member-of-valid 'post group) ; Ordinary news group.
- (and (gnus-member-of-valid 'post-mail group) ; Combined group.
- (eq (gnus-request-type group article) 'news))))
-
-(defun gnus-inews-news (&optional use-group-method)
- "Send a news message.
-
-If given a non-zero prefix and the group is a foreign group, this
-function will attempt to use the foreign server to post the article.
-
-If given an zero prefix, the user will be prompted for a posting
-method to use."
- (interactive "P")
- (unless (gnus-alive-p)
- (error "Gnus is dead; you can't post anything."))
- (or gnus-current-select-method
- (setq gnus-current-select-method gnus-select-method))
- (let* ((case-fold-search nil)
- (reply gnus-article-reply)
- error post-result)
- (save-excursion
- (gnus-start-news-server) ;Use default server.
- (widen)
- (goto-char (point-min))
- (run-hooks 'news-inews-hook)
-
- ;; Send to server.
- (gnus-message 5 "Posting to USENET...")
- (setq post-result (funcall gnus-inews-article-function use-group-method))
- (cond
- ((eq post-result 'illegal)
- (setq error t)
- (ding))
- (post-result
- (gnus-message 5 "Posting to USENET...done")
- (set-buffer-modified-p nil)
- ;; We mark the article as replied.
- (when (gnus-buffer-exists-p (car-safe reply))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-article-as-replied (cdr reply)))))
- (t
- ;; We cannot signal an error.
- (setq error t)
- (ding)
- (gnus-message
- 1 "Article rejected: %s"
- (gnus-status-message
- (gnus-post-method gnus-newsgroup-name use-group-method t))))))
-
- (let ((conf gnus-prev-winconf))
- (unless error
- (bury-buffer)
- ;; Restore last window configuration.
- (and conf (set-window-configuration conf))))))
-
-(defun gnus-inews-narrow-to-headers ()
- (widen)
- (narrow-to-region
- (goto-char (point-min))
- (or (and (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (match-beginning 0))
- (point-max)))
- (goto-char (point-min)))
-
-(defun gnus-inews-send-mail-copy ()
- ;; Mail the message if To, Bcc or Cc exists.
- (let* ((types '("to" "bcc" "cc"))
- (ty types)
- (buffer (current-buffer)))
- (save-restriction
- (widen)
- (gnus-inews-narrow-to-headers)
-
- (while ty
- (or (mail-fetch-field (car ty) nil t)
- (setq types (delete (car ty) types)))
- (setq ty (cdr ty)))
-
- (if (not types)
- ;; We do not want to send mail.
- ()
- (gnus-message 5 "Sending via mail...")
- (widen)
- (save-excursion
- ;; We copy the article over to a temp buffer since we are
- ;; going to modify it a little.
- (nnheader-set-temp-buffer " *Gnus-mailing*")
- (insert-buffer-substring buffer)
- ;; We remove Fcc, because we don't want the mailer to see
- ;; that header.
- (gnus-inews-narrow-to-headers)
- (nnheader-remove-header "fcc")
-
- ;; Insert the X-Courtesy-Message header.
- (and (or (member "to" types)
- (member "cc" types))
- (progn
- (goto-char (point-max))
- (insert "Posted-To: "
- (mail-fetch-field "newsgroups") "\n")))
-
- (widen)
-
- (if (and gnus-mail-courtesy-message
- (or (member "to" types)
- (member "cc" types)))
- ;; We only want to insert the courtesy mail message if
- ;; we use To or Cc; Bcc should not have one. Well, if
- ;; both Bcc and To are present, it will get one
- ;; anyway.
- (progn
- ;; Insert "courtesy" mail message.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (insert gnus-mail-courtesy-message)))
-
- (gnus-mail-send t)
- (kill-buffer (current-buffer))
- (gnus-message 5 "Sending via mail...done"))))))
-
-(defun gnus-inews-remove-headers-after-mail ()
- (save-excursion
- (save-restriction
- (let ((case-fold-search t))
- (gnus-inews-narrow-to-headers)
- ;; Remove Bcc completely.
- (nnheader-remove-header "bcc")
- ;; We transform To and Cc headers to avoid re-mailing if the user
- ;; accidentally (or purposefully) leans on the `C-c C-c' keys
- ;; and the news server rejects the posting.
- (while (re-search-forward "^\\(to\\|[bcf]cc\\|cc\\):" nil t)
- (beginning-of-line)
- (insert "X-"))
- (widen)))))
-
-(defun gnus-inews-dex-headers ()
- "Remove \"X-\" prefixes from To and Cc headers."
- (save-excursion
- (save-restriction
- (let ((case-fold-search t))
- (nnheader-narrow-to-headers)
- (while (re-search-forward "^X-\\(to\\|[bcf]cc\\|cc\\):" nil t)
- (beginning-of-line)
- (delete-char 2))
- (widen)))))
-
-(defun gnus-inews-remove-empty-headers ()
- "Remove empty headers from news and mail.
-The buffer should be narrowed to the headers before this function is
-called."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^[^ \t:]+:\\([ \t]*\n\\)+[^ \t]" nil t)
- (delete-region (match-beginning 0) (1- (match-end 0)))
- (beginning-of-line))))
-
-(defun gnus-inews-check-post ()
- "Check whether the post looks ok."
- (or
- (not gnus-check-before-posting)
- (and
- ;; We narrow to the headers and check them first.
- (save-excursion
- (save-restriction
- (gnus-inews-narrow-to-headers)
- (and
- ;; Check for commands in Subject.
- (or
- (gnus-check-before-posting 'subject-cmsg)
- (save-excursion
- (if (string-match "^cmsg " (mail-fetch-field "subject"))
- (gnus-y-or-n-p
- "The control code \"cmsg \" is in the subject. Really post? ")
- t)))
- ;; Check for multiple identical headers.
- (or (gnus-check-before-posting 'multiple-headers)
- (save-excursion
- (let (found)
- (while (and (not found)
- (re-search-forward "^[^ \t:]+: " nil t))
- (save-excursion
- (or (re-search-forward
- (concat "^" (setq found
- (buffer-substring
- (match-beginning 0)
- (- (match-end 0) 2))))
- nil t)
- (setq found nil))))
- (if found
- (gnus-y-or-n-p
- (format "Multiple %s headers. Really post? " found))
- t))))
- ;; Check for Version and Sendsys.
- (or (gnus-check-before-posting 'sendsys)
- (save-excursion
- (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
- (gnus-y-or-n-p
- (format "The article contains a %s command. Really post? "
- (buffer-substring (match-beginning 0)
- (1- (match-end 0)))))
- t)))
- ;; Check for Approved.
- (or (gnus-check-before-posting 'approved)
- (save-excursion
- (if (re-search-forward "^Approved:" nil t)
- (gnus-y-or-n-p
- "The article contains an Approved header. Really post? ")
- t)))
- ;; Check whether a Followup-To has redirected the newsgroup.
- (or
- (gnus-check-before-posting 'redirected-followup)
- (not gnus-newsgroup-followup)
- (save-excursion
- (let ((followups (gnus-tokenize-header
- (mail-fetch-field "Newsgroups")))
- (newsgroups (gnus-tokenize-header
- (car gnus-newsgroup-followup))))
- (while (and followups
- (member (car followups) newsgroups))
- (setq followups (cdr followups)))
- (if (not followups)
- t
- (gnus-y-or-n-p
- "Followup redirected from original newsgroups. Really post? "
- )))))
- ;; Check the Message-ID header.
- (or (gnus-check-before-posting 'message-id)
- (save-excursion
- (let* ((case-fold-search t)
- (message-id (mail-fetch-field "message-id")))
- (or (not message-id)
- (and (string-match "@" message-id)
- (string-match "@[^\\.]*\\." message-id))
- (gnus-y-or-n-p
- (format
- "The Message-ID looks strange: \"%s\". Really post? "
- message-id))))))
- ;; Check whether any headers are empty.
- (or (gnus-check-before-posting 'empty-headers)
- (save-excursion
- (let ((post t))
- (goto-char (point-min))
- (while (and post (not (eobp)))
- (when (looking-at "\\([^ :]+\\):[ \t]\n[^ \t]")
- (setq post
- (gnus-y-or-n-p
- (format
- "The %s header is empty. Really post? "
- (match-string 1)))))
- (forward-line 1))
- post)))
- ;; Check the From header.
- (or
- (gnus-check-before-posting 'from)
- (save-excursion
- (let* ((case-fold-search t)
- (from (mail-fetch-field "from")))
- (cond
- ((not from)
- (gnus-y-or-n-p "There is no From line. Really post? "))
- ((not (string-match "@[^\\.]*\\." from))
- (gnus-y-or-n-p
- (format
- "The address looks strange: \"%s\". Really post? " from)))
- ((string-match "(.*).*(.*)" from)
- (gnus-y-or-n-p
- (format
- "The From header looks strange: \"%s\". Really post? "
- from)))
- ((string-match "<[^>]+> *$" from)
- (let ((name (substring from 0 (match-beginning 0))))
- (or
- (string-match "^ *\"[^\"]*\" *$" name)
- (not (string-match "[][.!()<>@,;:\\]" name))
- (gnus-y-or-n-p
- (format
- "The From header name has bogus characters. Really post? "
- from)))))
- (t t)))))
- )))
- ;; Check for long lines.
- (or (gnus-check-before-posting 'long-lines)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (while (and
- (progn
- (end-of-line)
- (< (current-column) 80))
- (zerop (forward-line 1))))
- (or (bolp)
- (eobp)
- (gnus-y-or-n-p
- "You have lines longer than 79 characters. Really post? "))))
- ;; Check whether the article is empty.
- (or (gnus-check-before-posting 'empty)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (or (re-search-forward "[^ \n\t]" nil t)
- (gnus-y-or-n-p "Empty article. Really post?"))))
- ;; Check for control characters.
- (or (gnus-check-before-posting 'control-chars)
- (save-excursion
- (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
- (gnus-y-or-n-p
- "The article contains control characters. Really post? ")
- t)))
- ;; Check excessive size.
- (or (gnus-check-before-posting 'size)
- (if (> (buffer-size) 60000)
- (gnus-y-or-n-p
- (format "The article is %d octets long. Really post? "
- (buffer-size)))
- t))
- ;; Use the (size . checksum) variable to see whether the
- ;; article is empty or has only quoted text.
- (or
- (gnus-check-before-posting 'new-text)
- (not gnus-article-check-size)
- (if (and (= (buffer-size) (car gnus-article-check-size))
- (= (gnus-article-checksum) (cdr gnus-article-check-size)))
- (gnus-y-or-n-p
- "It looks like there's no new text in your article. Really post? ")
- t))
- ;; Check the length of the signature.
- (or (gnus-check-before-posting 'signature)
- (progn
- (goto-char (point-max))
- (if (not (re-search-backward gnus-signature-separator nil t))
- t
- (if (> (count-lines (point) (point-max)) 5)
- (gnus-y-or-n-p
- (format
- "Your .sig is %d lines; it should be max 4. Really post? "
- (count-lines (point) (point-max))))
- t)))))))
-
-(defvar gnus-inews-sent-ids nil)
-
-(defun gnus-inews-reject-message ()
- "Check whether this message has already been sent."
- (when gnus-sent-message-ids-file
- (let ((message-id (save-restriction (gnus-inews-narrow-to-headers)
- (mail-fetch-field "message-id")))
- end)
- (when message-id
- (unless gnus-inews-sent-ids
- (condition-case ()
- (load t t t)
- (error nil)))
- (if (member message-id gnus-inews-sent-ids)
- ;; Reject this message.
- (not (gnus-yes-or-no-p
- (format "Message %s already sent. Send anyway? "
- message-id)))
- (push message-id gnus-inews-sent-ids)
- ;; Chop off the last Message-IDs.
- (when (setq end (nthcdr gnus-sent-message-ids-length
- gnus-inews-sent-ids))
- (setcdr end nil))
- (nnheader-temp-write gnus-sent-message-ids-file
- (prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)))
- nil)))))
-
-(defun gnus-tokenize-header (header &optional separator)
- "Split HEADER into a list of header elements.
-\",\" is used as the separator."
- (let* ((beg 0)
- (separator (or separator ","))
- (regexp
- (format "[ \t]*\\([^%s]+\\)?\\([%s]+\\|\\'\\)" separator separator))
- elems)
- (while (and (string-match regexp header beg)
- (< beg (length header)))
- (when (match-beginning 1)
- (push (match-string 1 header) elems))
- (setq beg (match-end 0)))
- (nreverse elems)))
-
-(defun gnus-article-checksum ()
- (let ((sum 0))
- (save-excursion
- (while (not (eobp))
- (setq sum (logxor sum (following-char)))
- (forward-char 1)))
- sum))
-
-;; Returns non-nil if this type is not to be checked.
-(defun gnus-check-before-posting (type)
- (not
- (or (not gnus-check-before-posting)
- (if (listp gnus-check-before-posting)
- (memq type gnus-check-before-posting)
- t))))
-
-(defun gnus-cancel-news ()
- "Cancel an article you posted."
- (interactive)
- (if (or gnus-expert-user
- (gnus-yes-or-no-p "Do you really want to cancel this article? "))
- (let ((from nil)
- (newsgroups nil)
- (message-id nil)
- (distribution nil))
- (or (gnus-news-group-p gnus-newsgroup-name)
- (error "This backend does not support canceling"))
- (save-excursion
- ;; Get header info. from original article.
- (save-restriction
- (gnus-article-show-all-headers)
- (goto-char (point-min))
- (search-forward "\n\n" nil 'move)
- (narrow-to-region (point-min) (point))
- (setq from (mail-fetch-field "from"))
- (setq newsgroups (mail-fetch-field "newsgroups"))
- (setq message-id (mail-fetch-field "message-id"))
- (setq distribution (mail-fetch-field "distribution")))
- ;; Verify if the article is absolutely user's by comparing
- ;; user id with value of its From: field.
- (if (not
- (string-equal
- (downcase (gnus-mail-strip-quoted-names from))
- (downcase (gnus-mail-strip-quoted-names
- (gnus-inews-user-name)))))
- (progn
- (ding) (gnus-message 3 "This article is not yours.")
- nil)
- ;; Make control article.
- (set-buffer (get-buffer-create " *Gnus-canceling*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (insert "Newsgroups: " newsgroups "\n"
- "From: " (gnus-inews-user-name) "\n"
- "Subject: cancel " message-id "\n"
- "Control: cancel " message-id "\n"
- (if distribution
- (concat "Distribution: " distribution "\n")
- "")
- mail-header-separator "\n"
- "This is a cancel message from " from ".\n")
- ;; Send the control article to NNTP server.
- (gnus-message 5 "Canceling your article...")
- (prog1
- (if (funcall gnus-inews-article-function)
- (gnus-message 5 "Canceling your article...done")
- (progn
- (ding)
- (gnus-message 1 "Cancel failed; %s"
- (gnus-status-message gnus-newsgroup-name))
- nil)
- t)
- ;; Kill the article buffer.
- (kill-buffer (current-buffer))))))))
-
-(defun gnus-inews-remove-signature ()
- "Remove the signature from the text between point and mark.
-The text will also be indented the normal way.
-This function can be used in `mail-citation-hook', for instance."
- (save-excursion
- (let ((start (point))
- mark)
- (if (not (re-search-forward gnus-signature-separator (mark t) t))
- ;; No signature here, so we just indent the cited text.
- (mail-indent-citation)
- ;; Find the last non-empty line.
- (forward-line -1)
- (while (looking-at "[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (setq mark (set-marker (make-marker) (point)))
- (goto-char start)
- (mail-indent-citation)
- ;; Enable undoing the deletion.
- (undo-boundary)
- (delete-region mark (mark t))
- (set-marker mark nil)))))
-