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