;;; gnuspost.el --- post news commands for GNUS newsreader
-;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1990, 1993, 1994 Free Software Foundation, Inc.
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Version: $Header: gnuspost.el,v 4.1 93/07/19 15:43:46 umerin Exp $
+;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
;; Keywords: news
;; This file is part of GNU Emacs.
;;; Post a News using NNTP
;;;###autoload
-(fset 'sendnews 'gnus-post-news)
+(defalias 'sendnews 'gnus-post-news)
;;;###autoload
-(fset 'postnews 'gnus-post-news)
+(defalias 'postnews 'gnus-post-news)
;;;###autoload
(defun gnus-post-news ()
(if (eq major-mode 'gnus-article-mode) gnus-newsgroup-name))
(subject nil)
;; Get default distribution.
- (distribution (car gnus-local-distributions)))
+ (distribution (car gnus-local-distributions))
+ (followup-to nil))
;; Connect to NNTP server if not connected yet, and get
;; several information.
(if (not (gnus-server-opened))
;; Which do you like? (UMERIN)
;; (setq newsgroups (read-string "Newsgroups: " "general"))
(or newsgroups ;Use the default newsgroup.
- (setq newsgroups
- (completing-read "Newsgroup: "
- gnus-newsrc-assoc
- nil 'require-match
- newsgroups ;Default newsgroup.
- )))
+ (let (group)
+ (while (not
+ (string=
+ (setq group
+ (completing-read "Newsgroup: "
+ gnus-newsrc-assoc
+ nil 'require-match))
+ ""))
+ (or followup-to (setq followup-to group))
+ (if newsgroups
+ (setq newsgroups (concat newsgroups "," group))
+ (setq newsgroups group)))))
(setq subject (read-string "Subject: "))
;; Choose a distribution from gnus-distribution-list.
;; completing-read should not be used with
;; 'require-match functionality in order to allow use
;; of unknow distribution.
+ (gnus-read-distributions-file)
(setq distribution
(if (consp gnus-distribution-list)
(completing-read "Distribution: "
;; Suggested by ichikawa@flab.fujitsu.junet.
(mail-position-on-field "Distribution")
(insert (or distribution ""))
+ ;; Add Followup-To header
+ (if followup-to
+ (progn
+ (mail-position-on-field "Followup-To")
+ (insert followup-to)))
;; Handle author copy using FCC field.
(if gnus-author-copy
(progn
(search-forward "\n\n")
(point)))))
(setq from (mail-fetch-field "from"))
+ ;; Get reply-to working corrrectly for gnus-auto-mail-to-author (jpm)
+ (setq reply-to (mail-fetch-field "reply-to"))
(setq news-reply-yank-from from)
(setq subject (mail-fetch-field "subject"))
(setq date (mail-fetch-field "date"))
(mail-position-on-field "FCC")
(insert gnus-author-copy)))
;; Insert To: FROM field, which is expected to mail the
- ;; message to the author of the article too.
- (if (and gnus-auto-mail-to-author from)
+ ;; message to the author of the article too. Use Reply-To
+ ;; field like gnus-mail-reply-using-m* (jpm).
+ (if (and gnus-auto-mail-to-author (or reply-to from))
(progn
(goto-char (point-min))
- (insert "To: " from "\n")))
+ (insert "To: " (or reply-to from) "\n")))
(goto-char (point-max)))
;; Yank original article automatically.
(if yank
(widen)
(goto-char (point-min))
(run-hooks 'news-inews-hook)
- ;; Mail the message too if To: or Cc: exists.
- (if (save-restriction
- (narrow-to-region
- (point-min)
- (progn
+ (save-restriction
+ (narrow-to-region
+ (point-min)
+ (progn
+ (goto-char (point-min))
+ (search-forward (concat "\n" mail-header-separator "\n"))
+ (point)))
+
+ ;; Correct newsgroups field: change sequence of spaces to comma and
+ ;; eliminate spaces around commas. Eliminate imbedded line breaks.
+ (goto-char (point-min))
+ (if (search-forward-regexp "^Newsgroups: +" nil t)
+ (save-restriction
+ (narrow-to-region
+ (point)
+ (if (re-search-forward "^[^ \t]" nil 'end)
+ (match-beginning 0)
+ (point-max)))
(goto-char (point-min))
- (search-forward (concat "\n" mail-header-separator "\n"))
- (point)))
- (or (mail-fetch-field "to" nil t)
- (mail-fetch-field "cc" nil t)))
- (if gnus-mail-send-method
- (progn
- (message "Sending via mail...")
- (funcall gnus-mail-send-method)
- (message "Sending via mail... done"))
- (ding)
- (message "No mailer defined. To: and/or Cc: fields ignored.")
- (sit-for 1)))
+ (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
+ (goto-char (point-min))
+ (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
+ ))
+
+ ;; Mail the message too if To: or Cc: exists.
+ (if (or (mail-fetch-field "to" nil t)
+ (mail-fetch-field "cc" nil t))
+ (if gnus-mail-send-method
+ (progn
+ (message "Sending via mail...")
+ (widen)
+ (funcall gnus-mail-send-method)
+ (message "Sending via mail... done"))
+ (ding)
+ (message "No mailer defined. To: and/or Cc: fields ignored.")
+ (sit-for 1))))
+
;; Send to NNTP server.
(message "Posting to USENET...")
(if (gnus-inews-article)
(ding) (message "This article is not yours."))
;; Make control article.
(set-buffer (get-buffer-create " *GNUS-canceling*"))
- (buffer-flush-undo (current-buffer))
+ (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert "Newsgroups: " newsgroups "\n"
"Subject: cancel " message-id "\n"
(tmpbuf (get-buffer-create " *GNUS-posting*")))
(save-excursion
(set-buffer tmpbuf)
- (buffer-flush-undo (current-buffer))
+ (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-buffer-substring artbuf)
;; Remove the header separator.
(if (file-exists-p signature)
(progn
(goto-char (point-max))
- (insert "--\n")
+ (insert "-- \n")
(insert-file-contents signature)))
))))))
(t
;; Suggested by hyoko@flab.fujitsu.junet.
;; Save article in Unix mail format by default.
- (funcall (or gnus-author-copy-saver 'rmail-output) fcc-file)
+ (if (and gnus-author-copy-saver
+ (not (eq gnus-author-copy-saver 'rmail-output)))
+ (funcall gnus-author-copy-saver fcc-file)
+ (if (and (file-readable-p fcc-file)
+ (mail-file-babyl-p fcc-file))
+ (gnus-output-to-rmail fcc-file)
+ (rmail-output fcc-file 1 t t)))
))
)
))
))
(defun gnus-inews-user-name ()
- "Return user's network address as `NAME@DOMAIN (FULL NAME)'."
- (let ((login-name (gnus-inews-login-name))
- (full-name (gnus-inews-full-name)))
- (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from)
+ "Return user's network address as `NAME@DOMAIN (FULLNAME)'."
+ (let ((full-name (gnus-inews-full-name)))
+ (concat (if (or gnus-user-login-name gnus-use-generic-from
+ gnus-local-domain (getenv "DOMAINNAME"))
+ (concat (gnus-inews-login-name) "@"
+ (gnus-inews-domain-name gnus-use-generic-from))
+ user-mail-address)
;; User's full name.
(cond ((string-equal full-name "") "")
((string-equal full-name "&") ;Unix hack.
(defun gnus-inews-login-name ()
"Return user login name.
-Got from the variable gnus-user-login-name, the environment variables
-USER and LOGNAME, and the function user-login-name."
- (or gnus-user-login-name
- (getenv "USER") (getenv "LOGNAME") (user-login-name)))
+Got from the variable `gnus-user-login-name' and the function
+`user-login-name'."
+ (or gnus-user-login-name (user-login-name)))
(defun gnus-inews-full-name ()
"Return user full name.
-Got from the variable gnus-user-full-name, the environment variable
-NAME, and the function user-full-name."
+Got from the variable `gnus-user-full-name', the environment variable
+NAME, and the function `user-full-name'."
(or gnus-user-full-name
(getenv "NAME") (user-full-name)))
name; if it is non-nil, strip of local host name from the domain name.
If the function `system-name' returns full internet name and the
domain is undefined, the domain name is got from it."
- ;; Note: compatibility hack. This will be removed in the next version.
(and (null gnus-local-domain)
(boundp 'gnus-your-domain)
(setq gnus-local-domain gnus-your-domain))
- ;; End of compatibility hack.
- (let ((domain (or (if (stringp genericfrom) genericfrom)
- (getenv "DOMAINNAME")
- gnus-local-domain
- ;; Function `system-name' may return full internet name.
- ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
- (if (string-match "\\." (system-name))
- (substring (system-name) (match-end 0)))
- (read-string "Domain name (no host): ")))
- (host (or (if (string-match "\\." (system-name))
- (substring (system-name) 0 (match-beginning 0)))
- (system-name))))
- (if (string-equal "." (substring domain 0 1))
- (setq domain (substring domain 1)))
- (if (null gnus-local-domain)
- (setq gnus-local-domain domain))
- ;; Support GENERICFROM as same as standard Bnews system.
- ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
- (cond ((null genericfrom)
- (concat host "." domain))
- ;;((stringp genericfrom) genericfrom)
- (t domain))
- ))
+ (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
+ (let ((domain (or (if (stringp genericfrom) genericfrom)
+ (getenv "DOMAINNAME")
+ gnus-local-domain
+ ;; Function `system-name' may return full internet name.
+ ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
+ (if (string-match "\\." (system-name))
+ (substring (system-name) (match-end 0)))
+ (read-string "Domain name (no host): ")))
+ (host (or (if (string-match "\\." (system-name))
+ (substring (system-name) 0 (match-beginning 0)))
+ (system-name))))
+ (if (string-equal "." (substring domain 0 1))
+ (setq domain (substring domain 1)))
+ ;; Support GENERICFROM as same as standard Bnews system.
+ ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
+ (cond ((null genericfrom)
+ (concat host "." domain))
+ ;;((stringp genericfrom) genericfrom)
+ (t domain)))
+ (substring user-mail-address (1+ (string-match "@" user-mail-address)))))
(defun gnus-inews-message-id ()
"Generate unique Message-ID for user."