;;; 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>
+;; 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."
(defun gnus-current-time-zone (time)
"The local time zone in effect at TIME, or nil if not known."
- (let ((z (and (fboundp 'current-time-zone) (current-time-zone now))))
+ (let ((z (and (fboundp 'current-time-zone) (current-time-zone time))))
(if (and z (car z)) z gnus-local-timezone)))
(defun gnus-inews-date ()
zone "GMT"))
(defun gnus-inews-buggy-date (&optional time)
- "A buggy date string that represents TIME; this ignores the time zone
-and does not conform to the Usenet standard, but it sometimes works anyway.
+ "A buggy date string that represents TIME.
TIME is optional and defaults to the current time.
Some older versions of Emacs always act as if TIME is nil."
(let ((date (if (fboundp 'current-time)
gnus-local-organization
private-file)))
(and (stringp organization)
+ (> (length organization) 0)
(string-equal (substring organization 0 1) "/")
;; Get it from the user and system file.
;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath).
HCoop / bpt / emacs.git / blobdiff