comparison lisp/mail/rnewspost.el @ 35:63b375f17a65

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