Function: message-send-news

message-send-news is a byte-compiled function defined in message.el.gz.

Signature

(message-send-news &optional ARG)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/message.el.gz
(defun message-send-news (&optional arg)
  (require 'gnus-msg)
  (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
	 (case-fold-search nil)
	 (method (if (functionp message-post-method)
		     (funcall message-post-method arg)
		   message-post-method))
	 (newsgroups-field (save-restriction
			    (message-narrow-to-headers-or-head)
			    (message-fetch-field "Newsgroups")))
	 (followup-field (save-restriction
			   (message-narrow-to-headers-or-head)
			   (message-fetch-field "Followup-To")))
	 ;; BUG: We really need to get the charset for each name in the
	 ;; Newsgroups and Followup-To lines to allow crossposting
	 ;; between group names with incompatible character sets.
	 ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
	 (group-field-charset
	  (gnus-group-name-charset method newsgroups-field))
	 (followup-field-charset
	  (gnus-group-name-charset method (or followup-field "")))
	 (rfc2047-header-encoding-alist
	  (append (when group-field-charset
		    (list (cons "Newsgroups" group-field-charset)))
		  (when followup-field-charset
		    (list (cons "Followup-To" followup-field-charset)))
		  rfc2047-header-encoding-alist))
	 (messbuf (current-buffer))
	 (message-syntax-checks
	  (if (and arg
		   (listp message-syntax-checks))
	      (cons '(existing-newsgroups . disabled)
		    message-syntax-checks)
	    message-syntax-checks))
	 (message-this-is-news t)
	 (message-posting-charset
	  (gnus-setup-posting-charset newsgroups-field))
	 result)
    (if (not (message-check-news-body-syntax))
	nil
      (save-restriction
	(message-narrow-to-headers)
	;; Insert some headers.
	(message-generate-headers message-required-news-headers)
	(message-insert-canlock)
	;; Let the user do all of the above.
	(run-hooks 'message-header-hook))
      ;; Note: This check will be disabled by the ".*" default value for
      ;; gnus-group-name-charset-group-alist. -- Pa 2001-10-07.
      (when (and group-field-charset
		 (listp message-syntax-checks))
	(setq message-syntax-checks
	      (cons '(valid-newsgroups . disabled)
		    message-syntax-checks)))
      (message-cleanup-headers)
      (if (not (let ((message-post-method method))
		 (message-check-news-syntax)))
	  nil
	(unwind-protect
	    (with-current-buffer tembuf
	      (buffer-disable-undo)
	      (erase-buffer)
	      ;; Avoid copying text props (except hard newlines).
	      (insert
	       (with-current-buffer messbuf
		 (mml-buffer-substring-no-properties-except-some
		  (point-min) (point-max))))
	      (message-encode-message-body)
	      (message--cache-encoded messbuf)
	      ;; Remove some headers.
	      (save-restriction
		(message-narrow-to-headers)
		;; We (re)generate the Lines header.
		(when (memq 'Lines message-required-mail-headers)
		  (message-generate-headers '(Lines)))
		;; Remove some headers.
		(message-remove-header message-ignored-news-headers t)
                (mail-encode-encoded-word-buffer))
	      (goto-char (point-max))
	      ;; require one newline at the end.
	      (or (= (preceding-char) ?\n)
		  (insert ?\n))
	      (let ((case-fold-search t))
		;; Remove the delimiter.
		(goto-char (point-min))
		(re-search-forward
		 (concat "^" (regexp-quote mail-header-separator) "\n"))
		(replace-match "\n")
		(backward-char 1))
	      (run-hooks 'message-send-news-hook)
	      (gnus-open-server method)
	      (message "Sending news via %s..." (gnus-server-string method))
	      (setq result (let ((mail-header-separator ""))
			     (gnus-request-post method))))
	  (kill-buffer tembuf))
	(set-buffer messbuf)
	(if result
	    (push 'news message-sent-message-via)
	  (message "Couldn't send message via news: %s"
		   (nnheader-get-report (car method)))
	  nil)))))