-(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)))))))