xref: /386bsd/usr/local/lib/emacs/19.25/lisp/rnewspost.el (revision a2142627)
1;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs
2
3;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
4
5;; Maintainer: FSF
6;; Keywords: mail, news
7
8;; This file is part of GNU Emacs.
9
10;; GNU Emacs is free software; you can redistribute it and/or modify
11;; it under the terms of the GNU General Public License as published by
12;; the Free Software Foundation; either version 2, or (at your option)
13;; any later version.
14
15;; GNU Emacs is distributed in the hope that it will be useful,
16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18;; GNU General Public License for more details.
19
20;; You should have received a copy of the GNU General Public License
21;; along with GNU Emacs; see the file COPYING.  If not, write to
22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24;; Change Log:
25
26;; moved posting and mail code from rnews.el
27;;	tower@prep.ai.mit.edu Wed Oct 29 1986
28;; brought posting code almost up to the revision of RFC 850 for News 2.11
29;; - couldn't see handling the special meaning of the Keyword: poster
30;; - not worth the code space to support the old A news Title: (which
31;;   Subject: replaced) and Article-I.D.: (which Message-ID: replaced)
32;;	tower@prep Nov 86
33;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body
34;;	tower@prep 21 Nov 86
35;; added (require 'rnews)	tower@prep 22 Apr 87
36;; restricted call of news-show-all-headers in news-post-news & news-reply
37;;	tower@prep 28 Apr 87
38;; commented out Posting-Front-End to save USENET bytes tower@prep Jul 31 87
39;; commented out -n and -t args in news-inews     tower@prep 15 Oct 87
40
41;Now in paths.el.
42;(defvar news-inews-program "inews"
43;  "Function to post news.")
44
45;; Replying and posting news items are done by these functions.
46;; imported from rmail and modified to work with rnews ...
47;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes.
48;; this is done so that rnews can operate independently from rmail.el and
49;; sendmail and dosen't have to autoload these functions.
50;;
51;;; >> Nuked by Mly to autoload those functions again, as the duplication of
52;;; >>  code was making maintenance too difficult.
53
54;;; Code:
55
56(require 'sendmail)
57(require 'rnews)
58
59(defvar news-reply-mode-map () "Mode map used by news-reply.")
60
61(or news-reply-mode-map
62    (progn
63      (setq news-reply-mode-map (make-keymap))
64      (define-key news-reply-mode-map "\C-c?" 'describe-mode)
65      (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
66      (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
67      (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
68      (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
69      (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
70      (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
71      (define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body)
72      (define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature)
73      (define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original)
74      (define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
75      (define-key news-reply-mode-map "\C-c\C-c" 'news-inews)
76      (define-key news-reply-mode-map "\C-c\C-s" 'news-inews)))
77
78(defun news-reply-mode ()
79  "Major mode for editing news to be posted on USENET.
80First-time posters are asked to please read the articles in newsgroup:
81                                                     news.announce.newusers .
82Like Text Mode but with these additional commands:
83
84C-c C-s  news-inews (post the message)    C-c C-c  news-inews
85C-c C-f	 move to a header field (and create it if there isn't):
86	 C-c C-f C-n  move to Newsgroups:	C-c C-f C-s  move to Subj:
87	 C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
88	 C-c C-f C-d  move to Distribution:	C-c C-f C-a  move to Summary:
89C-c C-y  news-reply-yank-original (insert current message, in NEWS).
90C-c C-q  mail-fill-yanked-message (fill what was yanked).
91C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13)."
92  (interactive)
93  ;; require...
94  (or (fboundp 'mail-setup) (load "sendmail"))
95  (kill-all-local-variables)
96  (make-local-variable 'mail-reply-buffer)
97  (setq mail-reply-buffer nil)
98  (set-syntax-table text-mode-syntax-table)
99  (use-local-map news-reply-mode-map)
100  (setq local-abbrev-table text-mode-abbrev-table)
101  (setq major-mode 'news-reply-mode)
102  (setq mode-name "News")
103  (make-local-variable 'paragraph-separate)
104  (make-local-variable 'paragraph-start)
105  (setq paragraph-start (concat "^" mail-header-separator "$\\|"
106				paragraph-start))
107  (setq paragraph-separate (concat "^" mail-header-separator "$\\|"
108				   paragraph-separate))
109  (run-hooks 'text-mode-hook 'news-reply-mode-hook))
110
111(defvar news-reply-yank-from
112  "Save From: field for news-reply-yank-original."
113  "")
114
115(defvar news-reply-yank-message-id
116  "Save Message-Id: field for news-reply-yank-original."
117  "")
118
119(defun news-reply-yank-original (arg)
120  "Insert the message being replied to, if any (in rmail).
121Puts point before the text and mark after.
122Indents each nonblank line ARG spaces (default 3).
123Just \\[universal-argument] as argument means don't indent
124and don't delete any header fields."
125  (interactive "P")
126  (mail-yank-original arg)
127  (exchange-point-and-mark)
128  (run-hooks 'news-reply-header-hook))
129
130(defvar news-reply-header-hook
131  '(lambda ()
132	 (insert "In article " news-reply-yank-message-id
133			 " " news-reply-yank-from " writes:\n\n"))
134  "Hook for inserting a header at the top of a yanked message.")
135
136(defun news-reply-newsgroups ()
137  "Move point to end of Newsgroups: field.
138RFC 850 constrains the Newsgroups: field to be a comma separated list of valid
139newsgroups names at your site:
140Newsgroups: news.misc,comp.misc,rec.misc"
141  (interactive)
142  (expand-abbrev)
143  (goto-char (point-min))
144  (mail-position-on-field "Newsgroups"))
145
146(defun news-reply-followup-to ()
147  "Move point to end of Followup-To: field.  Create the field if none.
148One usually requests followups to only one newsgroup.
149RFC 850 constrains the Followup-To: field to be a comma separated list of valid
150newsgroups names at your site, that are also in the Newsgroups: field:
151Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
152Followup-To: news.misc,comp.misc,rec.misc"
153  (interactive)
154  (expand-abbrev)
155  (or (mail-position-on-field "Followup-To" t)
156      (progn (mail-position-on-field "newsgroups")
157	     (insert "\nFollowup-To: ")))
158	 ;; @@ could do a completing read based on the Newsgroups: field to
159	 ;; @@ fill in the Followup-To: field
160)
161
162(defun news-reply-distribution ()
163  "Move point to end of Distribution: optional field.
164Create the field if none.  Without this field the posting goes to all of
165USENET.  The field is used to restrict the posting to parts of USENET."
166  (interactive)
167  (expand-abbrev)
168  (mail-position-on-field "Distribution")
169  ;; @@could do a completing read based on the news library file:
170  ;; @@    ../distributions  to fill in the field.
171  )
172
173(defun news-reply-keywords ()
174  "Move point to end of Keywords: optional field.  Create the field if none.
175Used as an aid to the news reader, it can contain a few, well selected keywords
176identifying the message."
177  (interactive)
178  (expand-abbrev)
179  (mail-position-on-field "Keywords"))
180
181(defun news-reply-summary ()
182  "Move point to end of Summary: optional field.  Create the field if none.
183Used as an aid to the news reader, it can contain a succinct
184summary (abstract) of the message."
185  (interactive)
186  (expand-abbrev)
187  (mail-position-on-field "Summary"))
188
189(defun news-reply-signature ()
190  "The inews program appends ~/.signature automatically."
191  (interactive)
192  (message "~/.signature will be appended automatically."))
193
194(defun news-setup (to subject in-reply-to newsgroups replybuffer)
195  "Setup the news reply or posting buffer with the proper headers and in
196news-reply-mode."
197  (setq mail-reply-buffer replybuffer)
198  (let ((mail-setup-hook nil))
199    (if (null to)
200	;; this hack is needed so that inews wont be confused by
201	;; the fcc: and bcc: fields
202	(let ((mail-self-blind nil)
203	      (mail-archive-file-name nil))
204	  (mail-setup to subject in-reply-to nil replybuffer nil)
205	  (beginning-of-line)
206	  (delete-region (point) (progn (forward-line 1) (point)))
207	  (goto-char (point-max)))
208      (mail-setup to subject in-reply-to nil replybuffer nil))
209    ;;;(mail-position-on-field "Posting-Front-End")
210    ;;;(insert (emacs-version))
211    (goto-char (point-max))
212    (if (let ((case-fold-search t))
213	  (re-search-backward "^Subject:" (point-min) t))
214	(progn (beginning-of-line)
215	       (insert "Newsgroups: " (or newsgroups "") "\n")
216	       (if (not newsgroups)
217		   (backward-char 1)
218		 (goto-char (point-max)))))
219    (run-hooks 'news-setup-hook)))
220
221(defun news-inews ()
222  "Send a news message using inews."
223  (interactive)
224  (let* (newsgroups subject
225		    (case-fold-search nil))
226    (save-excursion
227      (save-restriction
228	(goto-char (point-min))
229	(search-forward (concat "\n" mail-header-separator "\n"))
230	(narrow-to-region (point-min) (point))
231	(setq newsgroups (mail-fetch-field "newsgroups")
232	      subject (mail-fetch-field "subject")))
233      (widen)
234      (goto-char (point-min))
235      (run-hooks 'news-inews-hook)
236      (goto-char (point-min))
237      (search-forward (concat "\n" mail-header-separator "\n"))
238      (replace-match "\n\n")
239      (goto-char (point-max))
240      ;; require a newline at the end for inews to append .signature to
241      (or (= (preceding-char) ?\n)
242	  (insert ?\n))
243      (message "Posting to USENET...")
244      (call-process-region (point-min) (point-max)
245			   news-inews-program nil 0 nil
246			   "-h")	; take all header lines!
247			   ;@@ setting of subject and newsgroups still needed?
248			   ;"-t" subject
249			   ;"-n" newsgroups
250      (message "Posting to USENET... done")
251      (goto-char (point-min))		;restore internal header separator
252      (search-forward "\n\n")
253      (replace-match (concat "\n" mail-header-separator "\n"))
254      (set-buffer-modified-p nil))
255    (and (fboundp 'bury-buffer) (bury-buffer))))
256
257;@@ shares some code with news-reply and news-post-news
258(defun news-mail-reply ()
259  "Mail a reply to the author of the current article.
260While composing the reply, use \\[news-reply-yank-original] to yank the
261original message into it."
262  (interactive)
263  (let (from cc subject date to reply-to
264	     (buffer (current-buffer)))
265    (save-restriction
266      (narrow-to-region (point-min) (progn (goto-line (point-min))
267					   (search-forward "\n\n")
268					   (- (point) 1)))
269      (setq from (mail-fetch-field "from")
270	    subject (mail-fetch-field "subject")
271	    reply-to (mail-fetch-field "reply-to")
272	    date (mail-fetch-field "date"))
273      (setq to from)
274      (pop-to-buffer "*mail*")
275      (mail nil
276	    (if reply-to reply-to to)
277	    subject
278	    (let ((stop-pos (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
279	      (concat (if stop-pos (substring from 0 stop-pos) from)
280		      "'s message of "
281		      date))
282	    nil
283	   buffer))))
284
285;@@ the guts of news-reply and news-post-news should be combined. -tower
286(defun news-reply ()
287  "Compose and post a reply (aka a followup) to the current article on USENET.
288While composing the followup, use \\[news-reply-yank-original] to yank the
289original message into it."
290  (interactive)
291  (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
292      (let (from cc subject date to followup-to newsgroups message-of
293		 references distribution message-id
294		 (buffer (current-buffer)))
295	(save-restriction
296	  (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
297					;@@	of article file
298	       (equal major-mode 'news-mode) ;@@ if rmail-mode,
299					;@@	should show full headers
300	       (progn
301		 (news-show-all-headers) ;@@ should save/restore header state,
302					;@@	but rnews.el lacks support
303		 (narrow-to-region (point-min) (progn (goto-char (point-min))
304						      (search-forward "\n\n")
305						      (- (point) 1)))))
306	  (setq from (mail-fetch-field "from")
307		news-reply-yank-from from
308		;; @@ not handling old Title: field
309		subject (mail-fetch-field "subject")
310		date (mail-fetch-field "date")
311		followup-to (mail-fetch-field "followup-to")
312		newsgroups (or followup-to
313			       (mail-fetch-field "newsgroups"))
314		references (mail-fetch-field "references")
315		;; @@ not handling old Article-I.D.: field
316		distribution (mail-fetch-field "distribution")
317		message-id (mail-fetch-field "message-id")
318		news-reply-yank-message-id message-id)
319	  (pop-to-buffer "*post-news*")
320	  (news-reply-mode)
321	  (if (and (buffer-modified-p)
322		   (not
323		    (y-or-n-p "Unsent article being composed; erase it? ")))
324	      ()
325	    (progn
326	      (erase-buffer)
327	      (and subject
328		   (progn (if (string-match "\\`Re: " subject)
329			      (while (string-match "\\`Re: " subject)
330				(setq subject (substring subject 4))))
331			  (setq subject (concat "Re: " subject))))
332	      (and from
333		   (progn
334		     (let ((stop-pos
335			    (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
336		       (setq message-of
337			     (concat
338			      (if stop-pos (substring from 0 stop-pos) from)
339			      "'s message of "
340			      date)))))
341	      (news-setup
342	       nil
343	       subject
344	       message-of
345	       newsgroups
346	       buffer)
347	      (if followup-to
348		  (progn (news-reply-followup-to)
349			 (insert followup-to)))
350	      (if distribution
351		  (progn
352		    (mail-position-on-field "Distribution")
353		    (insert distribution)))
354	      (mail-position-on-field "References")
355	      (if references
356		  (insert references))
357	      (if (and references message-id)
358		  (insert " "))
359	      (if message-id
360		  (insert message-id))
361	      (goto-char (point-max))))))
362    (message "")))
363
364;@@ the guts of news-reply and news-post-news should be combined. -tower
365(defun news-post-news ()
366  "Begin editing a new USENET news article to be posted.
367Type \\[describe-mode] once editing the article to get a list of commands."
368  (interactive)
369  (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
370      (let ((buffer (current-buffer)))
371	(save-restriction
372	  (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
373					;@@	of article file
374	       (equal major-mode 'news-mode) ;@@ if rmail-mode,
375					;@@	should show full headers
376	       (progn
377		 (news-show-all-headers) ;@@ should save/restore header state,
378					;@@	but rnews.el lacks support
379		 (narrow-to-region (point-min) (progn (goto-char (point-min))
380						      (search-forward "\n\n")
381						      (- (point) 1)))))
382	  (setq news-reply-yank-from (mail-fetch-field "from")
383		;; @@ not handling old Article-I.D.: field
384		news-reply-yank-message-id (mail-fetch-field "message-id")))
385	(pop-to-buffer "*post-news*")
386	(news-reply-mode)
387	(if (and (buffer-modified-p)
388		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
389	    ()				;@@ not saving point from last time
390	  (progn (erase-buffer)
391		 (news-setup () () () () buffer))))
392  (message "")))
393
394(defun news-mail-other-window ()
395  "Send mail in another window.
396While composing the message, use \\[news-reply-yank-original] to yank the
397original message into it."
398  (interactive)
399  (mail-other-window nil nil nil nil nil (current-buffer)))
400
401;;; rnewspost.el ends here
402