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