![[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 [Apple XNU] / GNUtools / emacs / lisp|
Return to rnewspost.el CVS log | Up to [Apple XNU] / GNUtools / emacs / 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 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: ;; [email protected] 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: (insert "In article " news-reply-yank-message-id
120: " " news-reply-yank-from " writes:\n\n"))
121:
122: (defun news-reply-newsgroups ()
123: "Move point to end of Newsgroups: field.
124: RFC 850 constrains the Newsgroups: field to be a comma separated list of valid
125: newsgroups names at your site:
126: Newsgroups: news.misc,comp.misc,rec.misc"
127: (interactive)
128: (expand-abbrev)
129: (goto-char (point-min))
130: (mail-position-on-field "Newsgroups"))
131:
132: (defun news-reply-followup-to ()
133: "Move point to end of Followup-To: field. Create the field if none.
134: One usually requests followups to only one newsgroup.
135: RFC 850 constrains the Followup-To: field to be a comma separated list of valid
136: newsgroups names at your site, that are also in the Newsgroups: field:
137: Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
138: Followup-To: news.misc,comp.misc,rec.misc"
139: (interactive)
140: (expand-abbrev)
141: (or (mail-position-on-field "Followup-To" t)
142: (progn (mail-position-on-field "newsgroups")
143: (insert "\nFollowup-To: ")))
144: ;; @@ could do a completing read based on the Newsgroups: field to
145: ;; @@ fill in the Followup-To: field
146: )
147:
148: (defun news-reply-distribution ()
149: "Move point to end of Distribution: optional field.
150: Create the field if none. Without this field the posting goes to all of
151: USENET. The field is used to restrict the posting to parts of USENET."
152: (interactive)
153: (expand-abbrev)
154: (mail-position-on-field "Distribution")
155: ;; @@could do a completing read based on the news library file:
156: ;; @@ ../distributions to fill in the field.
157: )
158:
159: (defun news-reply-keywords ()
160: "Move point to end of Keywords: optional field. Create the field if none.
161: Used as an aid to the news reader, it can contain a few, well selected keywords
162: identifying the message."
163: (interactive)
164: (expand-abbrev)
165: (mail-position-on-field "Keywords"))
166:
167: (defun news-reply-summary ()
168: "Move point to end of Summary: optional field. Create the field if none.
169: Used as an aid to the news reader, it can contain a succinct
170: summary (abstract) of the message."
171: (interactive)
172: (expand-abbrev)
173: (mail-position-on-field "Summary"))
174:
175: (defun news-reply-signature ()
176: "The inews program appends ~/.signature automatically."
177: (interactive)
178: (message "~/.signature will be appended automatically."))
179:
180: (defun news-setup (to subject in-reply-to newsgroups replybuffer)
181: "Setup the news reply or posting buffer with the proper headers and in
182: news-reply-mode."
183: (setq mail-reply-buffer replybuffer)
184: (let ((mail-setup-hook nil))
185: (if (null to)
186: ;; this hack is needed so that inews wont be confused by
187: ;; the fcc: and bcc: fields
188: (let ((mail-self-blind nil)
189: (mail-archive-file-name nil))
190: (mail-setup to subject in-reply-to nil replybuffer)
191: (beginning-of-line)
192: (delete-region (point) (progn (forward-line 1) (point)))
193: (goto-char (point-max)))
194: (mail-setup to subject in-reply-to nil replybuffer))
195: ;;;(mail-position-on-field "Posting-Front-End")
196: ;;;(insert (emacs-version))
197: (goto-char (point-max))
198: (if (let ((case-fold-search t))
199: (re-search-backward "^Subject:" (point-min) t))
200: (progn (beginning-of-line)
201: (insert "Newsgroups: " (or newsgroups "") "\n")
202: (if (not newsgroups)
203: (backward-char 1)
204: (goto-char (point-max)))))
205: (run-hooks 'news-setup-hook)))
206:
207: (defun news-inews ()
208: "Send a news message using inews."
209: (interactive)
210: (let* (newsgroups subject
211: (case-fold-search nil))
212: (save-excursion
213: (save-restriction
214: (goto-char (point-min))
215: (search-forward (concat "\n" mail-header-separator "\n"))
216: (narrow-to-region (point-min) (point))
217: (setq newsgroups (mail-fetch-field "newsgroups")
218: subject (mail-fetch-field "subject")))
219: (widen)
220: (goto-char (point-min))
221: (run-hooks 'news-inews-hook)
222: (goto-char (point-min))
223: (search-forward (concat "\n" mail-header-separator "\n"))
224: (replace-match "\n\n")
225: (goto-char (point-max))
226: ;; require a newline at the end for inews to append .signature to
227: (or (= (preceding-char) ?\n)
228: (insert ?\n))
229: (message "Posting to USENET...")
230: (call-process-region (point-min) (point-max)
231: news-inews-program nil 0 nil
232: "-h") ; take all header lines!
233: ;@@ setting of subject and newsgroups still needed?
234: ;"-t" subject
235: ;"-n" newsgroups
236: (message "Posting to USENET... done")
237: (goto-char (point-min)) ;restore internal header separator
238: (search-forward "\n\n")
239: (replace-match (concat "\n" mail-header-separator "\n"))
240: (set-buffer-modified-p nil))
241: (and (fboundp 'bury-buffer) (bury-buffer))))
242:
243: ;@@ shares some code with news-reply and news-post-news
244: (defun news-mail-reply ()
245: "Mail a reply to the author of the current article.
246: While composing the reply, use \\[news-reply-yank-original] to yank the
247: original message into it."
248: (interactive)
249: (let (from cc subject date to reply-to
250: (buffer (current-buffer)))
251: (save-restriction
252: (narrow-to-region (point-min) (progn (goto-line (point-min))
253: (search-forward "\n\n")
254: (- (point) 1)))
255: (setq from (mail-fetch-field "from")
256: subject (mail-fetch-field "subject")
257: reply-to (mail-fetch-field "reply-to")
258: date (mail-fetch-field "date"))
259: (setq to from)
260: (pop-to-buffer "*mail*")
261: (mail nil
262: (if reply-to reply-to to)
263: subject
264: (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from)))
265: (concat (if stop-pos (substring from 0 stop-pos) from)
266: "'s message of "
267: date))
268: nil
269: buffer))))
270:
271: ;@@ the guts of news-reply and news-post-news should be combined. -tower
272: (defun news-reply ()
273: "Compose and post a reply (aka a followup) to the current article on USENET.
274: While composing the followup, use \\[news-reply-yank-original] to yank the
275: original message into it."
276: (interactive)
277: (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
278: (let (from cc subject date to followup-to newsgroups message-of
279: references distribution message-id
280: (buffer (current-buffer)))
281: (save-restriction
282: (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
283: ;@@ of article file
284: (equal major-mode 'news-mode) ;@@ if rmail-mode,
285: ;@@ should show full headers
286: (progn
287: (news-show-all-headers) ;@@ should save/restore header state,
288: ;@@ but rnews.el lacks support
289: (narrow-to-region (point-min) (progn (goto-char (point-min))
290: (search-forward "\n\n")
291: (- (point) 1)))))
292: (setq from (mail-fetch-field "from")
293: news-reply-yank-from from
294: ;; @@ not handling old Title: field
295: subject (mail-fetch-field "subject")
296: date (mail-fetch-field "date")
297: followup-to (mail-fetch-field "followup-to")
298: newsgroups (or followup-to
299: (mail-fetch-field "newsgroups"))
300: references (mail-fetch-field "references")
301: ;; @@ not handling old Article-I.D.: field
302: distribution (mail-fetch-field "distribution")
303: message-id (mail-fetch-field "message-id")
304: news-reply-yank-message-id message-id)
305: (pop-to-buffer "*post-news*")
306: (news-reply-mode)
307: (if (and (buffer-modified-p)
308: (not
309: (y-or-n-p "Unsent article being composed; erase it? ")))
310: ()
311: (progn
312: (erase-buffer)
313: (and subject
314: (progn (if (string-match "\\`Re: " subject)
315: (while (string-match "\\`Re: " subject)
316: (setq subject (substring subject 4))))
317: (setq subject (concat "Re: " subject))))
318: (and from
319: (progn
320: (let ((stop-pos
321: (string-match " *at \\| *@ \\| *(\\| *<" from)))
322: (setq message-of
323: (concat
324: (if stop-pos (substring from 0 stop-pos) from)
325: "'s message of "
326: date)))))
327: (news-setup
328: nil
329: subject
330: message-of
331: newsgroups
332: buffer)
333: (if followup-to
334: (progn (news-reply-followup-to)
335: (insert followup-to)))
336: (if distribution
337: (progn
338: (mail-position-on-field "Distribution")
339: (insert distribution)))
340: (mail-position-on-field "References")
341: (if references
342: (insert references))
343: (if (and references message-id)
344: (insert " "))
345: (if message-id
346: (insert message-id))
347: (goto-char (point-max))))))
348: (message "")))
349:
350: ;@@ the guts of news-reply and news-post-news should be combined. -tower
351: (defun news-post-news ()
352: "Begin editing a new USENET news article to be posted.
353: Type \\[describe-mode] once editing the article to get a list of commands."
354: (interactive)
355: (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
356: (let ((buffer (current-buffer)))
357: (save-restriction
358: (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
359: ;@@ of article file
360: (equal major-mode 'news-mode) ;@@ if rmail-mode,
361: ;@@ should show full headers
362: (progn
363: (news-show-all-headers) ;@@ should save/restore header state,
364: ;@@ but rnews.el lacks support
365: (narrow-to-region (point-min) (progn (goto-char (point-min))
366: (search-forward "\n\n")
367: (- (point) 1)))))
368: (setq news-reply-yank-from (mail-fetch-field "from")
369: ;; @@ not handling old Article-I.D.: field
370: news-reply-yank-message-id (mail-fetch-field "message-id")))
371: (pop-to-buffer "*post-news*")
372: (news-reply-mode)
373: (if (and (buffer-modified-p)
374: (not (y-or-n-p "Unsent article being composed; erase it? ")))
375: () ;@@ not saving point from last time
376: (progn (erase-buffer)
377: (news-setup () () () () buffer))))
378: (message "")))
379:
380: (defun news-mail-other-window ()
381: "Send mail in another window.
382: While composing the message, use \\[news-reply-yank-original] to yank the
383: original message into it."
384: (interactive)
385: (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.