Mercurial > emacs
annotate lisp/=gnuspost.el @ 807:4f28bd14272c
*** empty log message ***
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Thu, 16 Jul 1992 21:47:34 +0000 |
parents | 22b98190b7ef |
children | e694e0879463 |
rev | line source |
---|---|
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
1 ;;; gnuspost.el --- post news commands for GNUS newsreader |
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
2 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
3 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
4 ;; Last-Modified: 10 Jun 1992 |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
5 |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
6 ;; $Header: gnuspost.el,v 1.2 90/03/23 13:25:16 umerin Locked $ |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
7 |
711
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
8 ;; Copyright (C) 1989, 1990 Free Software Foundation, Inc. |
267 | 9 |
10 ;; This file is part of GNU Emacs. | |
11 | |
711
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
12 ;; GNU Emacs is free software; you can redistribute it and/or modify |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
13 ;; it under the terms of the GNU General Public License as published by |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
14 ;; the Free Software Foundation; either version 2, or (at your option) |
711
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
15 ;; any later version. |
267 | 16 |
711
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
17 ;; GNU Emacs is distributed in the hope that it will be useful, |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
20 ;; GNU General Public License for more details. |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
21 |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
22 ;; You should have received a copy of the GNU General Public License |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
23 ;; along with GNU Emacs; see the file COPYING. If not, write to |
22b98190b7ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
660
diff
changeset
|
24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
267 | 25 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
26 ;;; Code: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
711
diff
changeset
|
27 |
267 | 28 (require 'gnus) |
29 | |
30 (defvar gnus-organization-file "/usr/lib/news/organization" | |
31 "*Local news organization file.") | |
32 | |
33 (defvar gnus-post-news-buffer "*post-news*") | |
34 (defvar gnus-winconf-post-news nil) | |
35 | |
36 (autoload 'news-reply-mode "rnewspost") | |
37 | |
38 ;;; Post news commands of GNUS Group Mode and Subject Mode | |
39 | |
40 (defun gnus-Group-post-news () | |
41 "Post an article." | |
42 (interactive) | |
43 ;; Save window configuration. | |
44 (setq gnus-winconf-post-news (current-window-configuration)) | |
45 (unwind-protect | |
46 (gnus-post-news) | |
47 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
48 (not (zerop (buffer-size)))) | |
49 ;; Restore last window configuration. | |
50 (set-window-configuration gnus-winconf-post-news))) | |
51 ;; We don't want to return to Subject buffer nor Article buffer later. | |
52 (if (get-buffer gnus-Subject-buffer) | |
53 (bury-buffer gnus-Subject-buffer)) | |
54 (if (get-buffer gnus-Article-buffer) | |
55 (bury-buffer gnus-Article-buffer))) | |
56 | |
57 (defun gnus-Subject-post-news () | |
58 "Post an article." | |
59 (interactive) | |
60 (gnus-Subject-select-article t nil) | |
61 ;; Save window configuration. | |
62 (setq gnus-winconf-post-news (current-window-configuration)) | |
63 (unwind-protect | |
64 (progn | |
65 (switch-to-buffer gnus-Article-buffer) | |
66 (widen) | |
67 (delete-other-windows) | |
68 (gnus-post-news)) | |
69 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
70 (not (zerop (buffer-size)))) | |
71 ;; Restore last window configuration. | |
72 (set-window-configuration gnus-winconf-post-news))) | |
73 ;; We don't want to return to Article buffer later. | |
74 (bury-buffer gnus-Article-buffer)) | |
75 | |
76 (defun gnus-Subject-post-reply (yank) | |
77 "Post a reply article. | |
78 If prefix argument YANK is non-nil, original article is yanked automatically." | |
79 (interactive "P") | |
80 (gnus-Subject-select-article t nil) | |
81 ;; Check Followup-To: poster. | |
82 (set-buffer gnus-Article-buffer) | |
83 (if (and gnus-use-followup-to | |
84 (string-equal "poster" (gnus-fetch-field "followup-to")) | |
85 (or (not (eq gnus-use-followup-to t)) | |
86 (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? ")))) | |
87 ;; Mail to the poster. GNUS is now RFC1036 compliant. | |
88 (gnus-Subject-mail-reply yank) | |
89 ;; Save window configuration. | |
90 (setq gnus-winconf-post-news (current-window-configuration)) | |
91 (unwind-protect | |
92 (progn | |
93 (switch-to-buffer gnus-Article-buffer) | |
94 (widen) | |
95 (delete-other-windows) | |
96 (gnus-news-reply yank)) | |
97 (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
98 (not (zerop (buffer-size)))) | |
99 ;; Restore last window configuration. | |
100 (set-window-configuration gnus-winconf-post-news))) | |
101 ;; We don't want to return to Article buffer later. | |
102 (bury-buffer gnus-Article-buffer))) | |
103 | |
104 (defun gnus-Subject-post-reply-with-original () | |
105 "Post a reply article with original article." | |
106 (interactive) | |
107 (gnus-Subject-post-reply t)) | |
108 | |
109 (defun gnus-Subject-cancel-article () | |
110 "Cancel an article you posted." | |
111 (interactive) | |
112 (gnus-Subject-select-article t nil) | |
113 (gnus-eval-in-buffer-window gnus-Article-buffer | |
114 (gnus-cancel-news))) | |
115 | |
116 | |
117 ;;; Post a News using NNTP | |
118 | |
119 ;;;###autoload | |
120 (fset 'sendnews 'gnus-post-news) | |
121 ;;;###autoload | |
122 (fset 'postnews 'gnus-post-news) | |
123 ;;;###autoload | |
124 (defun gnus-post-news () | |
125 "Begin editing a new USENET news article to be posted. | |
126 Type \\[describe-mode] once editing the article to get a list of commands." | |
127 (interactive) | |
128 (if (or (not gnus-novice-user) | |
129 (y-or-n-p "Are you sure you want to post to all of USENET? ")) | |
130 (let ((artbuf (current-buffer)) | |
131 (newsgroups ;Default newsgroup. | |
132 (if (eq major-mode 'gnus-Article-mode) gnus-newsgroup-name)) | |
133 (subject nil) | |
134 (distribution nil)) | |
135 (save-restriction | |
136 (and (not (zerop (buffer-size))) | |
137 ;;(equal major-mode 'news-mode) | |
138 (equal major-mode 'gnus-Article-mode) | |
139 (progn | |
140 ;;(news-show-all-headers) | |
141 (gnus-Article-show-all-headers) | |
142 (narrow-to-region (point-min) | |
143 (progn (goto-char (point-min)) | |
144 (search-forward "\n\n") | |
145 (point))))) | |
146 (setq news-reply-yank-from (mail-fetch-field "from")) | |
147 (setq news-reply-yank-message-id (mail-fetch-field "message-id"))) | |
148 (pop-to-buffer gnus-post-news-buffer) | |
149 (news-reply-mode) | |
150 (gnus-overload-functions) | |
151 (if (and (buffer-modified-p) | |
152 (> (buffer-size) 0) | |
153 (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
154 ;; Continue composition. | |
155 ;; Make news-reply-yank-original work on the current article. | |
156 (setq mail-reply-buffer artbuf) | |
157 (erase-buffer) | |
158 (if gnus-interactive-post | |
159 ;; Newsgroups, subject and distribution are asked for. | |
160 ;; Suggested by yuki@flab.fujitsu.junet. | |
161 (progn | |
162 ;; Subscribed newsgroup names are required for | |
163 ;; completing read of newsgroup. | |
164 (or gnus-newsrc-assoc | |
165 (gnus-read-newsrc-file)) | |
166 ;; Which do you like? (UMERIN) | |
167 ;; (setq newsgroups (read-string "Newsgroups: " "general")) | |
168 (or newsgroups ;Use the default newsgroup. | |
169 (setq newsgroups | |
170 (completing-read "Newsgroup: " gnus-newsrc-assoc | |
171 nil 'require-match | |
172 newsgroups ;Default newsgroup. | |
173 ))) | |
174 (setq subject (read-string "Subject: ")) | |
175 (setq distribution | |
176 (substring newsgroups 0 (string-match "\\." newsgroups))) | |
177 (if (string-equal distribution newsgroups) | |
178 ;; Newsgroup may be general or control. In this | |
179 ;; case, use default distribution. | |
180 (setq distribution gnus-default-distribution)) | |
181 (setq distribution | |
182 (read-string "Distribution: " distribution)) | |
183 ;; An empty string is ok to ignore gnus-default-distribution. | |
184 ;;(if (string-equal distribution "") | |
185 ;; (setq distribution nil)) | |
186 )) | |
187 (news-setup () subject () newsgroups artbuf) | |
188 ;; Make sure the article is posted by GNUS. | |
189 ;;(mail-position-on-field "Posting-Software") | |
190 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") | |
191 ;; Insert Distribution: field. | |
192 ;; Suggested by ichikawa@flab.fujitsu.junet. | |
193 (mail-position-on-field "Distribution") | |
194 (insert (or distribution gnus-default-distribution "")) | |
195 ;; Handle author copy using FCC field. | |
196 (if gnus-author-copy | |
197 (progn | |
198 (mail-position-on-field "FCC") | |
199 (insert gnus-author-copy))) | |
200 (if gnus-interactive-post | |
201 ;; All fields are filled in. | |
202 (goto-char (point-max)) | |
203 ;; Move point to Newsgroup: field. | |
204 (goto-char (point-min)) | |
205 (end-of-line)) | |
206 )) | |
207 (message ""))) | |
208 | |
209 (defun gnus-news-reply (&optional yank) | |
210 "Compose and post a reply (aka a followup) to the current article on USENET. | |
211 While composing the followup, use \\[news-reply-yank-original] to yank the | |
212 original message into it." | |
213 (interactive) | |
214 (if (or (not gnus-novice-user) | |
215 (y-or-n-p "Are you sure you want to followup to all of USENET? ")) | |
216 (let (from cc subject date to followup-to newsgroups message-of | |
217 references distribution message-id | |
218 (artbuf (current-buffer))) | |
219 (save-restriction | |
220 (and (not (zerop (buffer-size))) | |
221 ;;(equal major-mode 'news-mode) | |
222 (equal major-mode 'gnus-Article-mode) | |
223 (progn | |
224 ;; (news-show-all-headers) | |
225 (gnus-Article-show-all-headers) | |
226 (narrow-to-region (point-min) | |
227 (progn (goto-char (point-min)) | |
228 (search-forward "\n\n") | |
229 (point))))) | |
230 (setq from (mail-fetch-field "from")) | |
231 (setq news-reply-yank-from from) | |
232 (setq subject (mail-fetch-field "subject")) | |
233 (setq date (mail-fetch-field "date")) | |
234 (setq followup-to (mail-fetch-field "followup-to")) | |
235 ;; Ignore Followup-To: poster. | |
236 (if (or (null gnus-use-followup-to) ;Ignore followup-to: field. | |
237 (string-equal "" followup-to) ;Bogus header. | |
238 (string-equal "poster" followup-to)) | |
239 (setq followup-to nil)) | |
240 (setq newsgroups (or followup-to (mail-fetch-field "newsgroups"))) | |
241 (setq references (mail-fetch-field "references")) | |
242 (setq distribution (mail-fetch-field "distribution")) | |
243 (setq message-id (mail-fetch-field "message-id")) | |
244 (setq news-reply-yank-message-id message-id)) | |
245 (pop-to-buffer gnus-post-news-buffer) | |
246 (news-reply-mode) | |
247 (gnus-overload-functions) | |
248 (if (and (buffer-modified-p) | |
249 (> (buffer-size) 0) | |
250 (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
251 ;; Continue composition. | |
252 ;; Make news-reply-yank-original work on current article. | |
253 (setq mail-reply-buffer artbuf) | |
254 (erase-buffer) | |
255 (and subject | |
256 (setq subject | |
257 (concat "Re: " (gnus-simplify-subject subject 're-only)))) | |
258 (and from | |
259 (progn | |
260 (let ((stop-pos | |
261 (string-match " *at \\| *@ \\| *(\\| *<" from))) | |
262 (setq message-of | |
263 (concat | |
264 (if stop-pos (substring from 0 stop-pos) from) | |
265 "'s message of " | |
266 date))))) | |
267 (news-setup nil subject message-of newsgroups artbuf) | |
268 (if followup-to | |
269 (progn (news-reply-followup-to) | |
270 (insert followup-to))) | |
271 ;; Fold long references line to follow RFC1036. | |
272 (mail-position-on-field "References") | |
273 (let ((begin (point)) | |
274 (fill-column 79) | |
275 (fill-prefix "\t")) | |
276 (if references | |
277 (insert references)) | |
278 (if (and references message-id) | |
279 (insert " ")) | |
280 (if message-id | |
281 (insert message-id)) | |
282 ;; The region must end with a newline to fill the region | |
283 ;; without inserting extra newline. | |
284 (fill-region-as-paragraph begin (1+ (point)))) | |
285 ;; Make sure the article is posted by GNUS. | |
286 ;;(mail-position-on-field "Posting-Software") | |
287 ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") | |
288 ;; Distribution must be the same as original article. | |
289 (mail-position-on-field "Distribution") | |
290 (insert (or distribution "")) | |
291 ;; Handle author copy using FCC field. | |
292 (if gnus-author-copy | |
293 (progn | |
294 (mail-position-on-field "FCC") | |
295 (insert gnus-author-copy))) | |
296 (goto-char (point-max))) | |
297 ;; Yank original article automatically. | |
298 (if yank | |
299 (let ((last (point))) | |
300 (goto-char (point-max)) | |
301 (news-reply-yank-original nil) | |
302 (goto-char last))) | |
303 ) | |
304 (message ""))) | |
305 | |
306 (defun gnus-inews-news () | |
307 "Send a news message." | |
308 (interactive) | |
309 (let* ((case-fold-search nil) | |
310 (server-running (gnus-server-opened))) | |
311 (save-excursion | |
312 ;; It is possible to post a news without reading news using | |
313 ;; `gnus' before. | |
314 ;; Suggested by yuki@flab.fujitsu.junet. | |
315 (gnus-start-news-server) ;Use default server. | |
316 ;; NNTP server must be opened before current buffer is modified. | |
317 (widen) | |
318 (goto-char (point-min)) | |
319 (run-hooks 'news-inews-hook) | |
320 (goto-char (point-min)) | |
321 (search-forward (concat "\n" mail-header-separator "\n")) | |
322 (replace-match "\n\n") | |
323 (goto-char (point-max)) | |
324 ;; require a newline at the end for inews to append .signature to | |
325 (or (= (preceding-char) ?\n) | |
326 (insert ?\n)) | |
327 (message "Posting to USENET...") | |
328 ;; Post to NNTP server. | |
329 (if (gnus-inews-article) | |
330 (message "Posting to USENET... done") | |
331 ;; We cannot signal an error. | |
332 (ding) (message "Article rejected: %s" (gnus-status-message))) | |
333 (goto-char (point-min)) ;restore internal header separator | |
334 (search-forward "\n\n") | |
335 (replace-match (concat "\n" mail-header-separator "\n")) | |
336 (set-buffer-modified-p nil)) | |
337 ;; If NNTP server is opened by gnus-inews-news, close it by myself. | |
338 (or server-running | |
339 (gnus-close-server)) | |
340 (and (fboundp 'bury-buffer) (bury-buffer)) | |
341 ;; Restore last window configuration. | |
342 (and gnus-winconf-post-news | |
343 (set-window-configuration gnus-winconf-post-news)) | |
344 (setq gnus-winconf-post-news nil) | |
345 )) | |
346 | |
347 (defun gnus-cancel-news () | |
348 "Cancel an article you posted." | |
349 (interactive) | |
350 (if (yes-or-no-p "Do you really want to cancel this article? ") | |
351 (let ((from nil) | |
352 (newsgroups nil) | |
353 (message-id nil) | |
354 (distribution nil)) | |
355 (save-excursion | |
356 ;; Get header info. from original article. | |
357 (save-restriction | |
358 (gnus-Article-show-all-headers) | |
359 (goto-char (point-min)) | |
360 (search-forward "\n\n") | |
361 (narrow-to-region (point-min) (point)) | |
362 (setq from (mail-fetch-field "from")) | |
363 (setq newsgroups (mail-fetch-field "newsgroups")) | |
364 (setq message-id (mail-fetch-field "message-id")) | |
365 (setq distribution (mail-fetch-field "distribution"))) | |
366 ;; Verify if the article is absolutely user's by comparing | |
367 ;; user id with value of its From: field. | |
368 (if (not | |
369 (string-equal | |
370 (downcase (mail-strip-quoted-names from)) | |
371 (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) | |
372 (progn | |
373 (ding) (message "This article is not yours")) | |
374 ;; Make control article. | |
375 (set-buffer (get-buffer-create " *GNUS-posting*")) | |
376 (buffer-flush-undo (current-buffer)) | |
377 (erase-buffer) | |
378 (insert "Newsgroups: " newsgroups "\n" | |
379 "Subject: cancel " message-id "\n" | |
380 "Control: cancel " message-id "\n" | |
381 ;; We should not use the value of | |
382 ;; `gnus-default-distribution' as default value, | |
383 ;; because distribution must be as same as original | |
384 ;; article. | |
385 "Distribution: " (or distribution "") "\n" | |
386 ) | |
387 ;; Prepare article headers. | |
388 (gnus-inews-insert-headers) | |
389 (goto-char (point-max)) | |
390 ;; Insert empty line. | |
391 (insert "\n") | |
392 ;; Send the control article to NNTP server. | |
393 (message "Canceling your article...") | |
394 (if (gnus-request-post) | |
395 (message "Canceling your article... done") | |
396 (ding) (message "Failed to cancel your article")) | |
397 (kill-buffer (current-buffer)) | |
398 ))) | |
399 )) | |
400 | |
401 | |
402 ;;; Lowlevel inews interface | |
403 | |
404 (defun gnus-inews-article () | |
405 "NNTP inews interface." | |
406 (let ((signature | |
407 (if gnus-signature-file | |
408 (expand-file-name gnus-signature-file nil))) | |
409 (distribution nil) | |
410 (artbuf (current-buffer)) | |
411 (tmpbuf (get-buffer-create " *GNUS-posting*"))) | |
412 (save-excursion | |
413 (set-buffer tmpbuf) | |
414 (buffer-flush-undo (current-buffer)) | |
415 (erase-buffer) | |
416 (insert-buffer-substring artbuf) | |
417 ;; Get distribution. | |
418 (save-restriction | |
419 (goto-char (point-min)) | |
420 (search-forward "\n\n") | |
421 (narrow-to-region (point-min) (point)) | |
422 (setq distribution (mail-fetch-field "distribution"))) | |
423 (widen) | |
424 (if signature | |
425 (progn | |
426 ;; Change signature file by distribution. | |
427 ;; Suggested by hyoko@flab.fujitsu.junet. | |
428 (if (file-exists-p (concat signature "-" distribution)) | |
429 (setq signature (concat signature "-" distribution))) | |
430 ;; Insert signature. | |
431 (if (file-exists-p signature) | |
432 (progn | |
433 (goto-char (point-max)) | |
434 (insert "--\n") | |
435 (insert-file-contents signature))) | |
436 )) | |
437 ;; Prepare article headers. | |
438 (save-restriction | |
439 (goto-char (point-min)) | |
440 (search-forward "\n\n") | |
441 (narrow-to-region (point-min) (point)) | |
442 (gnus-inews-insert-headers) | |
443 ;; Save author copy of posted article. The article must be | |
444 ;; copied before being posted because `gnus-request-post' | |
445 ;; modifies the buffer. | |
446 (let ((case-fold-search t)) | |
447 ;; Find and handle any FCC fields. | |
448 (goto-char (point-min)) | |
449 (if (re-search-forward "^FCC:" nil t) | |
450 (gnus-inews-do-fcc)))) | |
451 (widen) | |
452 ;; Run final inews hooks. | |
453 (run-hooks 'gnus-Inews-article-hook) | |
454 ;; Post an article to NNTP server. | |
455 ;; Return NIL if post failed. | |
456 (prog1 | |
457 (gnus-request-post) | |
458 (kill-buffer (current-buffer))) | |
459 ))) | |
460 | |
461 (defun gnus-inews-do-fcc () | |
462 "Process FCC: fields." | |
463 (let ((fcc-list nil) | |
464 (fcc-file nil) | |
465 (case-fold-search t)) ;Should ignore case. | |
466 (save-excursion | |
467 (save-restriction | |
468 (goto-char (point-min)) | |
469 (while (re-search-forward "^FCC:[ \t]*" nil t) | |
470 (setq fcc-list (cons (buffer-substring (point) | |
471 (progn | |
472 (end-of-line) | |
473 (skip-chars-backward " \t") | |
474 (point))) | |
475 fcc-list)) | |
476 (delete-region (match-beginning 0) | |
477 (progn (forward-line 1) (point)))) | |
478 ;; Process FCC operations. | |
479 (widen) | |
480 (while fcc-list | |
481 (setq fcc-file (car fcc-list)) | |
482 (setq fcc-list (cdr fcc-list)) | |
483 (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) | |
484 (let ((program (substring fcc-file | |
485 (match-beginning 1) (match-end 1)))) | |
486 ;; Suggested by yuki@flab.fujitsu.junet. | |
487 ;; Send article to named program. | |
488 (call-process-region (point-min) (point-max) shell-file-name | |
489 nil nil nil "-c" program) | |
490 )) | |
491 (t | |
492 ;; Suggested by hyoko@flab.fujitsu.junet. | |
493 ;; Save article in Unix mail format by default. | |
494 (funcall (or gnus-author-copy-saver 'rmail-output) fcc-file) | |
495 )) | |
496 ) | |
497 )) | |
498 )) | |
499 | |
500 (defun gnus-inews-insert-headers () | |
501 "Prepare article headers. | |
502 Path:, From:, Subject: and Distribution: are generated. | |
503 Message-ID:, Date: and Organization: are optional." | |
504 (save-excursion | |
505 (let ((date (gnus-inews-date)) | |
506 (message-id (gnus-inews-message-id)) | |
507 (organization (gnus-inews-organization))) | |
508 ;; Insert from the top of headers. | |
509 (goto-char (point-min)) | |
510 (insert "Path: " (gnus-inews-path) "\n") | |
511 (insert "From: " (gnus-inews-user-name) "\n") | |
512 ;; If there is no subject, make Subject: field. | |
513 (or (mail-fetch-field "subject") | |
514 (insert "Subject: \n")) | |
515 ;; Insert random headers. | |
516 (if message-id | |
517 (insert "Message-ID: " message-id "\n")) | |
518 (if date | |
519 (insert "Date: " date "\n")) | |
520 (if organization | |
521 (let ((begin (point)) | |
522 (fill-column 79) | |
523 (fill-prefix "\t")) | |
524 (insert "Organization: " organization "\n") | |
525 (fill-region-as-paragraph begin (point)))) | |
526 (or (mail-fetch-field "distribution") | |
527 (insert "Distribution: \n")) | |
528 ))) | |
529 | |
530 (defun gnus-inews-path () | |
531 "Return uucp path." | |
532 (let ((login-name (gnus-inews-login-name))) | |
533 (cond ((null gnus-use-generic-path) | |
534 (concat gnus-nntp-server "!" login-name)) | |
535 ((stringp gnus-use-generic-path) | |
536 ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. | |
537 (concat gnus-use-generic-path "!" login-name)) | |
538 (t login-name)) | |
539 )) | |
540 | |
541 (defun gnus-inews-user-name () | |
542 "Return user's network address as `NAME@DOMAIN (FULL NAME)'." | |
543 (let ((login-name (gnus-inews-login-name)) | |
544 (full-name (gnus-inews-full-name))) | |
545 (concat login-name "@" (gnus-inews-domain-name gnus-use-generic-from) | |
546 ;; User's full name. | |
547 (cond ((string-equal full-name "") "") | |
548 ((string-equal full-name "&") ;Unix hack. | |
549 (concat " (" login-name ")")) | |
550 (t | |
551 (concat " (" full-name ")"))) | |
552 ))) | |
553 | |
554 (defun gnus-inews-login-name () | |
555 "Return user login name. | |
556 Got from the variable `gnus-user-login-name', the environment variables | |
557 USER and LOGNAME, and the function `user-login-name'." | |
558 (or gnus-user-login-name | |
559 (getenv "USER") (getenv "LOGNAME") (user-login-name))) | |
560 | |
561 (defun gnus-inews-full-name () | |
562 "Return user full name. | |
563 Got from the variable `gnus-user-full-name', the environment variable | |
564 NAME, and the function `user-full-name'." | |
565 (or gnus-user-full-name | |
566 (getenv "NAME") (user-full-name))) | |
567 | |
568 (defun gnus-inews-domain-name (&optional genericfrom) | |
569 "Return user's domain name. | |
570 If optional argument GENERICFROM is a string, use it as the domain | |
571 name; if it is non-nil, strip of local host name from the domain name. | |
572 If the function `system-name' returns full internet name and the | |
573 domain is undefined, the domain name is got from it." | |
574 (let ((domain (or (if (stringp genericfrom) genericfrom) | |
575 (getenv "DOMAINNAME") | |
576 gnus-your-domain | |
577 ;; Function `system-name' may return full internet name. | |
578 ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>. | |
579 (if (string-match "\\." (system-name)) | |
580 (substring (system-name) (match-end 0))) | |
581 (read-string "Domain name (no host): "))) | |
582 (host (or (if (string-match "\\." (system-name)) | |
583 (substring (system-name) 0 (match-beginning 0))) | |
584 (system-name)))) | |
585 (if (string-equal "." (substring domain 0 1)) | |
586 (setq domain (substring domain 1))) | |
587 (if (null gnus-your-domain) | |
588 (setq gnus-your-domain domain)) | |
589 ;; Support GENERICFROM as same as standard Bnews system. | |
590 ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. | |
591 (cond ((null genericfrom) | |
592 (concat host "." domain)) | |
593 ;;((stringp genericfrom) genericfrom) | |
594 (t domain)) | |
595 )) | |
596 | |
597 (defun gnus-inews-message-id () | |
598 "Generate unique Message-ID for user." | |
599 ;; Message-ID should not contain a slash and should be terminated by | |
600 ;; a number. I don't know the reason why it is so. | |
601 (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">")) | |
602 | |
603 (defun gnus-inews-unique-id () | |
604 "Generate unique ID from user name and current time." | |
605 (let ((date (current-time-string)) | |
606 (name (gnus-inews-login-name))) | |
607 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)" | |
608 date) | |
609 (concat (upcase name) "." | |
610 (substring date (match-beginning 6) (match-end 6)) ;Year | |
611 (substring date (match-beginning 1) (match-end 1)) ;Month | |
612 (substring date (match-beginning 2) (match-end 2)) ;Day | |
613 (substring date (match-beginning 3) (match-end 3)) ;Hour | |
614 (substring date (match-beginning 4) (match-end 4)) ;Minute | |
615 (substring date (match-beginning 5) (match-end 5)) ;Second | |
616 ) | |
617 (error "Cannot understand current-time-string: %s." date)) | |
618 )) | |
619 | |
620 (defun gnus-inews-date () | |
621 "Bnews date format string of today. Time zone is ignored." | |
622 ;; Insert buggy date (time zone is ignored), but I don't worry about | |
623 ;; it since inews will rewrite it. | |
624 (let ((date (current-time-string))) | |
625 (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" | |
626 date) | |
627 (concat (substring date (match-beginning 2) (match-end 2)) ;Day | |
628 " " | |
629 (substring date (match-beginning 1) (match-end 1)) ;Month | |
630 " " | |
631 (substring date (match-beginning 4) (match-end 4)) ;Year | |
632 " " | |
633 (substring date (match-beginning 3) (match-end 3))) ;Time | |
634 (error "Cannot understand current-time-string: %s." date)) | |
635 )) | |
636 | |
637 (defun gnus-inews-organization () | |
638 "Return user's organization. | |
639 The ORGANIZATION environment variable is used if defined. | |
640 If not, the variable `gnus-your-organization' is used instead. | |
641 If the value begins with a slash, it is taken as the name of a file | |
642 containing the organization." | |
643 ;; The organization must be got in this order since the ORGANIZATION | |
644 ;; environment variable is intended for user specific while | |
645 ;; gnus-your-organization is for machine or organization specific. | |
646 (let ((organization (or (getenv "ORGANIZATION") | |
647 gnus-your-organization | |
648 (expand-file-name "~/.organization" nil)))) | |
649 (and (stringp organization) | |
650 (string-equal (substring organization 0 1) "/") | |
651 ;; Get it from the user and system file. | |
652 ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath). | |
653 (let ((dist (mail-fetch-field "distribution"))) | |
654 (setq organization | |
655 (cond ((file-exists-p (concat organization "-" dist)) | |
656 (concat organization "-" dist)) | |
657 ((file-exists-p organization) organization) | |
658 ((file-exists-p gnus-organization-file) | |
659 gnus-organization-file) | |
660 (t organization))) | |
661 )) | |
662 (cond ((not (stringp organization)) nil) | |
663 ((and (string-equal (substring organization 0 1) "/") | |
664 (file-exists-p organization)) | |
665 ;; If the first character is `/', assume it is the name of | |
666 ;; a file containing the organization. | |
667 (save-excursion | |
668 (let ((tmpbuf (get-buffer-create " *GNUS organization*"))) | |
669 (set-buffer tmpbuf) | |
670 (erase-buffer) | |
671 (insert-file-contents organization) | |
672 (prog1 (buffer-string) | |
673 (kill-buffer tmpbuf)) | |
674 ))) | |
675 (t organization)) | |
676 )) | |
584 | 677 |
678 (provide 'gnuspost) | |
660
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
679 |
08eb386dd0f3
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
584
diff
changeset
|
680 ;;; gnuspost.el ends here |