X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2368506ddc7b8614d38dc3b7ddf1de2ff62b46f5..9afa72e8e6c422cc02cca010e9c07a03a87bdfd8:/lisp/gnuspost.el diff --git a/lisp/gnuspost.el b/lisp/gnuspost.el index 46c4d7a376..441feb245d 100644 --- a/lisp/gnuspost.el +++ b/lisp/gnuspost.el @@ -1,9 +1,8 @@ ;;; 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 -;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/gnuspost.el,v 1.16 1993/11/22 06:44:12 rms Exp $ +;; Author: Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. @@ -117,10 +116,10 @@ If prefix argument YANK is non-nil, original article is yanked automatically." ;;; 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 () @@ -134,7 +133,8 @@ Type \\[describe-mode] once editing the article to get a list of commands." (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)) @@ -176,12 +176,18 @@ Type \\[describe-mode] once editing the article to get a list of commands." ;; 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 @@ -208,6 +214,11 @@ Type \\[describe-mode] once editing the article to get a list of commands." ;; 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 @@ -244,6 +255,8 @@ original message into it." (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")) @@ -310,11 +323,12 @@ original message into it." (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 @@ -339,24 +353,43 @@ original message into it." (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) @@ -403,7 +436,7 @@ original message into it." (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" @@ -434,7 +467,7 @@ original message into it." (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. @@ -544,7 +577,7 @@ Signature file is specified by the variable gnus-signature-file." (if (file-exists-p signature) (progn (goto-char (point-max)) - (insert "--\n") + (insert "-- \n") (insert-file-contents signature))) )))))) @@ -595,7 +628,8 @@ a program specified by the rest of the value." (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) (rmail-file-p 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))) )) @@ -615,10 +649,13 @@ a program specified by the rest of the value." )) (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. @@ -629,15 +666,14 @@ a program specified by the rest of the value." (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))) @@ -647,33 +683,30 @@ If optional argument GENERICFROM is a string, use it as the domain 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 . - (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 . + (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."