"cyclic.com" addresses changed to "red-bean.com".
[bpt/emacs.git] / lisp / mail / rnewspost.el
CommitLineData
c88ab9ce
ER
1;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs
2
f8c25f1b 3;; Copyright (C) 1985, 1986, 1987, 1995 Free Software Foundation, Inc.
3a801d0c 4
e5167999 5;; Maintainer: FSF
d7b4d18f 6;; Keywords: mail, news
e5167999 7
0d20f9a0
JB
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
e5167999 12;; the Free Software Foundation; either version 2, or (at your option)
0d20f9a0
JB
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
e5167999
ER
24;; Change Log:
25
0d20f9a0
JB
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
0d20f9a0
JB
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
e5167999
ER
54;;; Code:
55
56(require 'sendmail)
57(require 'rnews)
58
0d20f9a0
JB
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))
0d20f9a0
JB
64 (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
65 (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
66 (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
67 (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
68 (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
69 (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
4ad33138 70 (define-key news-reply-mode-map "\C-c\C-t" 'mail-text)
0d20f9a0
JB
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)
ed17d24f
RS
76 (define-key news-reply-mode-map "\C-c\C-s" 'news-inews)
77 (define-key news-reply-mode-map [menu-bar] (make-sparse-keymap))
78 (define-key news-reply-mode-map [menu-bar fields]
79 (cons "Fields" (make-sparse-keymap "Fields")))
80 (define-key news-reply-mode-map [menu-bar fields news-reply-distribution]
81 '("Distribution" . news-reply-distribution))
82 (define-key news-reply-mode-map [menu-bar fields news-reply-keywords]
83 '("Keywords" . news-reply-keywords))
84 (define-key news-reply-mode-map [menu-bar fields news-reply-newsgroups]
85 '("Newsgroups" . news-reply-newsgroups))
86 (define-key news-reply-mode-map [menu-bar fields news-reply-followup-to]
87 '("Followup-to" . news-reply-followup-to))
88 (define-key news-reply-mode-map [menu-bar fields mail-subject]
89 '("Subject" . mail-subject))
90 (define-key news-reply-mode-map [menu-bar fields news-reply-summary]
91 '("Summary" . news-reply-summary))
92 (define-key news-reply-mode-map [menu-bar fields mail-text]
93 '("Text" . mail-text))
94 (define-key news-reply-mode-map [menu-bar news]
95 (cons "News" (make-sparse-keymap "News")))
96 (define-key news-reply-mode-map [menu-bar news news-caesar-buffer-body]
97 '("Rot13" . news-caesar-buffer-body))
98 (define-key news-reply-mode-map [menu-bar news news-reply-signature]
99 '("Signature" . news-reply-signature))
100 (define-key news-reply-mode-map [menu-bar news news-reply-yank-original]
101 '("Yank Original" . news-reply-yank-original))
102 (define-key news-reply-mode-map [menu-bar news mail-fill-yanked-message]
103 '("Fill Yanked Messages" . mail-fill-yanked-message))
104 (define-key news-reply-mode-map [menu-bar news news-inews]
105 '("Send" . news-inews))))
0d20f9a0
JB
106
107(defun news-reply-mode ()
108 "Major mode for editing news to be posted on USENET.
109First-time posters are asked to please read the articles in newsgroup:
110 news.announce.newusers .
111Like Text Mode but with these additional commands:
112
113C-c C-s news-inews (post the message) C-c C-c news-inews
114C-c C-f move to a header field (and create it if there isn't):
115 C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj:
116 C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords:
117 C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary:
118C-c C-y news-reply-yank-original (insert current message, in NEWS).
119C-c C-q mail-fill-yanked-message (fill what was yanked).
120C-c C-r caesar rotate all letters by 13 places in the article's body (rot13)."
121 (interactive)
122 ;; require...
123 (or (fboundp 'mail-setup) (load "sendmail"))
124 (kill-all-local-variables)
125 (make-local-variable 'mail-reply-buffer)
126 (setq mail-reply-buffer nil)
127 (set-syntax-table text-mode-syntax-table)
128 (use-local-map news-reply-mode-map)
129 (setq local-abbrev-table text-mode-abbrev-table)
130 (setq major-mode 'news-reply-mode)
c6f5b077 131 (setq mode-name "News Reply")
0d20f9a0
JB
132 (make-local-variable 'paragraph-separate)
133 (make-local-variable 'paragraph-start)
7e31e83e
RS
134 (setq paragraph-start
135 (concat "^" (regexp-quote mail-header-separator) "$\\|"
136 paragraph-start))
137 (setq paragraph-separate
138 (concat "^" (regexp-quote mail-header-separator) "$\\|"
139 paragraph-separate))
0d20f9a0
JB
140 (run-hooks 'text-mode-hook 'news-reply-mode-hook))
141
142(defvar news-reply-yank-from
d9f86af9 143 "Save `From:' field for `news-reply-yank-original'."
0d20f9a0
JB
144 "")
145
146(defvar news-reply-yank-message-id
d9f86af9 147 "Save `Message-Id:' field for `news-reply-yank-original'."
0d20f9a0
JB
148 "")
149
150(defun news-reply-yank-original (arg)
d9f86af9 151 "Insert the message being replied to, if any (in Mail mode).
0d20f9a0
JB
152Puts point before the text and mark after.
153Indents each nonblank line ARG spaces (default 3).
154Just \\[universal-argument] as argument means don't indent
155and don't delete any header fields."
156 (interactive "P")
157 (mail-yank-original arg)
158 (exchange-point-and-mark)
159 (run-hooks 'news-reply-header-hook))
160
161(defvar news-reply-header-hook
162 '(lambda ()
163 (insert "In article " news-reply-yank-message-id
164 " " news-reply-yank-from " writes:\n\n"))
165 "Hook for inserting a header at the top of a yanked message.")
166
167(defun news-reply-newsgroups ()
d9f86af9
RS
168 "Move point to end of `Newsgroups:' field.
169RFC 850 constrains the `Newsgroups:' field to be a comma-separated list
170of valid newsgroup names at your site. For example,
171 Newsgroups: news.misc,comp.misc,rec.misc"
0d20f9a0
JB
172 (interactive)
173 (expand-abbrev)
174 (goto-char (point-min))
175 (mail-position-on-field "Newsgroups"))
176
177(defun news-reply-followup-to ()
d9f86af9 178 "Move point to end of `Followup-To:' field. Create the field if none.
0d20f9a0 179One usually requests followups to only one newsgroup.
d9f86af9
RS
180RFC 850 constrains the `Followup-To:' field to be a comma-separated list
181of valid newsgroups names at your site, and it must be a subset of the
182`Newsgroups:' field. For example:
183 Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
184 Followup-To: news.misc,comp.misc,rec.misc"
0d20f9a0
JB
185 (interactive)
186 (expand-abbrev)
187 (or (mail-position-on-field "Followup-To" t)
188 (progn (mail-position-on-field "newsgroups")
189 (insert "\nFollowup-To: ")))
190 ;; @@ could do a completing read based on the Newsgroups: field to
191 ;; @@ fill in the Followup-To: field
192)
193
194(defun news-reply-distribution ()
d9f86af9 195 "Move point to end of `Distribution:' optional field.
0d20f9a0
JB
196Create the field if none. Without this field the posting goes to all of
197USENET. The field is used to restrict the posting to parts of USENET."
198 (interactive)
199 (expand-abbrev)
200 (mail-position-on-field "Distribution")
201 ;; @@could do a completing read based on the news library file:
202 ;; @@ ../distributions to fill in the field.
203 )
204
205(defun news-reply-keywords ()
d9f86af9 206 "Move point to end of `Keywords:' optional field. Create the field if none.
0d20f9a0
JB
207Used as an aid to the news reader, it can contain a few, well selected keywords
208identifying the message."
209 (interactive)
210 (expand-abbrev)
211 (mail-position-on-field "Keywords"))
212
213(defun news-reply-summary ()
d9f86af9 214 "Move point to end of `Summary:' optional field. Create the field if none.
0d20f9a0
JB
215Used as an aid to the news reader, it can contain a succinct
216summary (abstract) of the message."
217 (interactive)
218 (expand-abbrev)
219 (mail-position-on-field "Summary"))
220
221(defun news-reply-signature ()
e63b8030 222 "The inews program appends `~/.signature' automatically."
0d20f9a0 223 (interactive)
e63b8030 224 (message "`~/.signature' will be appended automatically."))
0d20f9a0
JB
225
226(defun news-setup (to subject in-reply-to newsgroups replybuffer)
d9f86af9 227 "Set up the news reply or posting buffer with the proper headers and mode."
0d20f9a0 228 (setq mail-reply-buffer replybuffer)
e63b8030
RS
229 (let ((mail-setup-hook nil)
230 ;; Avoid inserting a signature.
231 (mail-signature))
0d20f9a0
JB
232 (if (null to)
233 ;; this hack is needed so that inews wont be confused by
234 ;; the fcc: and bcc: fields
235 (let ((mail-self-blind nil)
236 (mail-archive-file-name nil))
237 (mail-setup to subject in-reply-to nil replybuffer nil)
238 (beginning-of-line)
38c132a9 239 (delete-region (point) (progn (forward-line 1) (point)))
0d20f9a0
JB
240 (goto-char (point-max)))
241 (mail-setup to subject in-reply-to nil replybuffer nil))
242 ;;;(mail-position-on-field "Posting-Front-End")
243 ;;;(insert (emacs-version))
244 (goto-char (point-max))
245 (if (let ((case-fold-search t))
246 (re-search-backward "^Subject:" (point-min) t))
247 (progn (beginning-of-line)
248 (insert "Newsgroups: " (or newsgroups "") "\n")
249 (if (not newsgroups)
250 (backward-char 1)
251 (goto-char (point-max)))))
252 (run-hooks 'news-setup-hook)))
253
254(defun news-inews ()
255 "Send a news message using inews."
256 (interactive)
257 (let* (newsgroups subject
258 (case-fold-search nil))
259 (save-excursion
260 (save-restriction
261 (goto-char (point-min))
262 (search-forward (concat "\n" mail-header-separator "\n"))
263 (narrow-to-region (point-min) (point))
264 (setq newsgroups (mail-fetch-field "newsgroups")
265 subject (mail-fetch-field "subject")))
266 (widen)
267 (goto-char (point-min))
268 (run-hooks 'news-inews-hook)
269 (goto-char (point-min))
270 (search-forward (concat "\n" mail-header-separator "\n"))
271 (replace-match "\n\n")
272 (goto-char (point-max))
273 ;; require a newline at the end for inews to append .signature to
274 (or (= (preceding-char) ?\n)
275 (insert ?\n))
276 (message "Posting to USENET...")
277 (call-process-region (point-min) (point-max)
278 news-inews-program nil 0 nil
279 "-h") ; take all header lines!
280 ;@@ setting of subject and newsgroups still needed?
281 ;"-t" subject
282 ;"-n" newsgroups
283 (message "Posting to USENET... done")
284 (goto-char (point-min)) ;restore internal header separator
285 (search-forward "\n\n")
286 (replace-match (concat "\n" mail-header-separator "\n"))
287 (set-buffer-modified-p nil))
288 (and (fboundp 'bury-buffer) (bury-buffer))))
289
290;@@ shares some code with news-reply and news-post-news
291(defun news-mail-reply ()
292 "Mail a reply to the author of the current article.
293While composing the reply, use \\[news-reply-yank-original] to yank the
294original message into it."
295 (interactive)
296 (let (from cc subject date to reply-to
297 (buffer (current-buffer)))
298 (save-restriction
299 (narrow-to-region (point-min) (progn (goto-line (point-min))
300 (search-forward "\n\n")
301 (- (point) 1)))
302 (setq from (mail-fetch-field "from")
303 subject (mail-fetch-field "subject")
304 reply-to (mail-fetch-field "reply-to")
56eb270e
RS
305 date (mail-fetch-field "date")))
306 (setq to from)
307 (pop-to-buffer "*mail*")
308 (mail nil
309 (if reply-to reply-to to)
310 subject
311 (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from)))
312 (concat (if stop-pos (substring from 0 stop-pos) from)
313 "'s message of "
314 date))
315 nil
316 buffer)))
0d20f9a0
JB
317
318;@@ the guts of news-reply and news-post-news should be combined. -tower
319(defun news-reply ()
320 "Compose and post a reply (aka a followup) to the current article on USENET.
321While composing the followup, use \\[news-reply-yank-original] to yank the
322original message into it."
323 (interactive)
324 (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
325 (let (from cc subject date to followup-to newsgroups message-of
326 references distribution message-id
327 (buffer (current-buffer)))
328 (save-restriction
329 (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
330 ;@@ of article file
331 (equal major-mode 'news-mode) ;@@ if rmail-mode,
332 ;@@ should show full headers
333 (progn
334 (news-show-all-headers) ;@@ should save/restore header state,
335 ;@@ but rnews.el lacks support
336 (narrow-to-region (point-min) (progn (goto-char (point-min))
337 (search-forward "\n\n")
338 (- (point) 1)))))
339 (setq from (mail-fetch-field "from")
340 news-reply-yank-from from
341 ;; @@ not handling old Title: field
342 subject (mail-fetch-field "subject")
343 date (mail-fetch-field "date")
344 followup-to (mail-fetch-field "followup-to")
345 newsgroups (or followup-to
346 (mail-fetch-field "newsgroups"))
347 references (mail-fetch-field "references")
348 ;; @@ not handling old Article-I.D.: field
349 distribution (mail-fetch-field "distribution")
350 message-id (mail-fetch-field "message-id")
351 news-reply-yank-message-id message-id)
352 (pop-to-buffer "*post-news*")
353 (news-reply-mode)
354 (if (and (buffer-modified-p)
355 (not
356 (y-or-n-p "Unsent article being composed; erase it? ")))
357 ()
358 (progn
359 (erase-buffer)
360 (and subject
361 (progn (if (string-match "\\`Re: " subject)
362 (while (string-match "\\`Re: " subject)
363 (setq subject (substring subject 4))))
364 (setq subject (concat "Re: " subject))))
365 (and from
366 (progn
367 (let ((stop-pos
368 (string-match " *at \\| *@ \\| *(\\| *<" from)))
369 (setq message-of
370 (concat
371 (if stop-pos (substring from 0 stop-pos) from)
372 "'s message of "
373 date)))))
374 (news-setup
375 nil
376 subject
377 message-of
378 newsgroups
379 buffer)
380 (if followup-to
381 (progn (news-reply-followup-to)
382 (insert followup-to)))
383 (if distribution
384 (progn
385 (mail-position-on-field "Distribution")
386 (insert distribution)))
387 (mail-position-on-field "References")
388 (if references
389 (insert references))
390 (if (and references message-id)
391 (insert " "))
392 (if message-id
393 (insert message-id))
394 (goto-char (point-max))))))
395 (message "")))
396
397;@@ the guts of news-reply and news-post-news should be combined. -tower
d9f86af9 398;;;###autoload
0d20f9a0
JB
399(defun news-post-news ()
400 "Begin editing a new USENET news article to be posted.
401Type \\[describe-mode] once editing the article to get a list of commands."
402 (interactive)
403 (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
404 (let ((buffer (current-buffer)))
405 (save-restriction
406 (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
407 ;@@ of article file
408 (equal major-mode 'news-mode) ;@@ if rmail-mode,
409 ;@@ should show full headers
410 (progn
411 (news-show-all-headers) ;@@ should save/restore header state,
412 ;@@ but rnews.el lacks support
413 (narrow-to-region (point-min) (progn (goto-char (point-min))
414 (search-forward "\n\n")
415 (- (point) 1)))))
416 (setq news-reply-yank-from (mail-fetch-field "from")
417 ;; @@ not handling old Article-I.D.: field
418 news-reply-yank-message-id (mail-fetch-field "message-id")))
419 (pop-to-buffer "*post-news*")
420 (news-reply-mode)
421 (if (and (buffer-modified-p)
422 (not (y-or-n-p "Unsent article being composed; erase it? ")))
423 () ;@@ not saving point from last time
424 (progn (erase-buffer)
425 (news-setup () () () () buffer))))
426 (message "")))
427
428(defun news-mail-other-window ()
429 "Send mail in another window.
430While composing the message, use \\[news-reply-yank-original] to yank the
431original message into it."
432 (interactive)
433 (mail-other-window nil nil nil nil nil (current-buffer)))
c88ab9ce
ER
434
435;;; rnewspost.el ends here