Commit | Line | Data |
---|---|---|
1a06eabd ER |
1 | ;;; gnuspost.el --- post news commands for GNUS newsreader |
2 | ||
8f1204db | 3 | ;; Copyright (C) 1989, 1990, 1993, 1994 Free Software Foundation, Inc. |
3a801d0c | 4 | |
43b028a0 | 5 | ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> |
fd7fa35a | 6 | ;; Keywords: news |
e5167999 | 7 | |
2f790b20 JB |
8 | ;; This file is part of GNU Emacs. |
9 | ||
08b684de RS |
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
11 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 12 | ;; the Free Software Foundation; either version 2, or (at your option) |
08b684de RS |
13 | ;; any later version. |
14 | ||
2f790b20 | 15 | ;; GNU Emacs is distributed in the hope that it will be useful, |
08b684de RS |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
2f790b20 | 23 | |
e5167999 ER |
24 | ;;; Code: |
25 | ||
2f790b20 JB |
26 | (require 'gnus) |
27 | ||
28 | (defvar gnus-organization-file "/usr/lib/news/organization" | |
29 | "*Local news organization file.") | |
30 | ||
31 | (defvar gnus-post-news-buffer "*post-news*") | |
32 | (defvar gnus-winconf-post-news nil) | |
33 | ||
34 | (autoload 'news-reply-mode "rnewspost") | |
b027f415 | 35 | (autoload 'timezone-make-date-arpa-standard "timezone") |
2f790b20 | 36 | |
b027f415 | 37 | ;;; Post news commands of GNUS Group Mode and Summary Mode |
2f790b20 | 38 | |
b027f415 | 39 | (defun gnus-group-post-news () |
2f790b20 JB |
40 | "Post an article." |
41 | (interactive) | |
42 | ;; Save window configuration. | |
43 | (setq gnus-winconf-post-news (current-window-configuration)) | |
44 | (unwind-protect | |
45 | (gnus-post-news) | |
46 | (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
47 | (not (zerop (buffer-size)))) | |
48 | ;; Restore last window configuration. | |
49 | (set-window-configuration gnus-winconf-post-news))) | |
b027f415 RS |
50 | ;; We don't want to return to Summary buffer nor Article buffer later. |
51 | (if (get-buffer gnus-summary-buffer) | |
52 | (bury-buffer gnus-summary-buffer)) | |
53 | (if (get-buffer gnus-article-buffer) | |
54 | (bury-buffer gnus-article-buffer))) | |
2f790b20 | 55 | |
b027f415 | 56 | (defun gnus-summary-post-news () |
2f790b20 JB |
57 | "Post an article." |
58 | (interactive) | |
b027f415 | 59 | (gnus-summary-select-article t nil) |
2f790b20 JB |
60 | ;; Save window configuration. |
61 | (setq gnus-winconf-post-news (current-window-configuration)) | |
62 | (unwind-protect | |
63 | (progn | |
b027f415 | 64 | (switch-to-buffer gnus-article-buffer) |
2f790b20 JB |
65 | (widen) |
66 | (delete-other-windows) | |
67 | (gnus-post-news)) | |
68 | (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
69 | (not (zerop (buffer-size)))) | |
70 | ;; Restore last window configuration. | |
71 | (set-window-configuration gnus-winconf-post-news))) | |
72 | ;; We don't want to return to Article buffer later. | |
b027f415 | 73 | (bury-buffer gnus-article-buffer)) |
2f790b20 | 74 | |
b027f415 | 75 | (defun gnus-summary-followup (yank) |
2f790b20 JB |
76 | "Post a reply article. |
77 | If prefix argument YANK is non-nil, original article is yanked automatically." | |
78 | (interactive "P") | |
b027f415 | 79 | (gnus-summary-select-article t nil) |
2f790b20 | 80 | ;; Check Followup-To: poster. |
b027f415 | 81 | (set-buffer gnus-article-buffer) |
2f790b20 JB |
82 | (if (and gnus-use-followup-to |
83 | (string-equal "poster" (gnus-fetch-field "followup-to")) | |
84 | (or (not (eq gnus-use-followup-to t)) | |
85 | (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? ")))) | |
86 | ;; Mail to the poster. GNUS is now RFC1036 compliant. | |
b027f415 | 87 | (gnus-summary-reply yank) |
2f790b20 JB |
88 | ;; Save window configuration. |
89 | (setq gnus-winconf-post-news (current-window-configuration)) | |
90 | (unwind-protect | |
91 | (progn | |
b027f415 | 92 | (switch-to-buffer gnus-article-buffer) |
2f790b20 JB |
93 | (widen) |
94 | (delete-other-windows) | |
95 | (gnus-news-reply yank)) | |
96 | (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) | |
97 | (not (zerop (buffer-size)))) | |
98 | ;; Restore last window configuration. | |
99 | (set-window-configuration gnus-winconf-post-news))) | |
100 | ;; We don't want to return to Article buffer later. | |
b027f415 | 101 | (bury-buffer gnus-article-buffer))) |
2f790b20 | 102 | |
b027f415 | 103 | (defun gnus-summary-followup-with-original () |
2f790b20 JB |
104 | "Post a reply article with original article." |
105 | (interactive) | |
b027f415 | 106 | (gnus-summary-followup t)) |
2f790b20 | 107 | |
b027f415 | 108 | (defun gnus-summary-cancel-article () |
2f790b20 JB |
109 | "Cancel an article you posted." |
110 | (interactive) | |
b027f415 RS |
111 | (gnus-summary-select-article t nil) |
112 | (gnus-eval-in-buffer-window gnus-article-buffer | |
2f790b20 JB |
113 | (gnus-cancel-news))) |
114 | ||
115 | \f | |
116 | ;;; Post a News using NNTP | |
117 | ||
118 | ;;;###autoload | |
85252418 | 119 | (defalias 'sendnews 'gnus-post-news) |
b027f415 | 120 | |
2f790b20 | 121 | ;;;###autoload |
85252418 | 122 | (defalias 'postnews 'gnus-post-news) |
b027f415 | 123 | |
2f790b20 JB |
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. | |
b027f415 | 133 | (if (eq major-mode 'gnus-article-mode) gnus-newsgroup-name)) |
2f790b20 | 134 | (subject nil) |
b027f415 | 135 | ;; Get default distribution. |
a082d8bd RS |
136 | (distribution (car gnus-local-distributions)) |
137 | (followup-to nil)) | |
b027f415 RS |
138 | ;; Connect to NNTP server if not connected yet, and get |
139 | ;; several information. | |
140 | (if (not (gnus-server-opened)) | |
141 | (progn | |
142 | (gnus-start-news-server t) ;Confirm server. | |
143 | (gnus-setup-news))) | |
144 | ;; Get current article information. | |
2f790b20 JB |
145 | (save-restriction |
146 | (and (not (zerop (buffer-size))) | |
147 | ;;(equal major-mode 'news-mode) | |
b027f415 | 148 | (equal major-mode 'gnus-article-mode) |
2f790b20 JB |
149 | (progn |
150 | ;;(news-show-all-headers) | |
b027f415 | 151 | (gnus-article-show-all-headers) |
2f790b20 JB |
152 | (narrow-to-region (point-min) |
153 | (progn (goto-char (point-min)) | |
154 | (search-forward "\n\n") | |
155 | (point))))) | |
156 | (setq news-reply-yank-from (mail-fetch-field "from")) | |
157 | (setq news-reply-yank-message-id (mail-fetch-field "message-id"))) | |
158 | (pop-to-buffer gnus-post-news-buffer) | |
159 | (news-reply-mode) | |
160 | (gnus-overload-functions) | |
161 | (if (and (buffer-modified-p) | |
162 | (> (buffer-size) 0) | |
163 | (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
164 | ;; Continue composition. | |
165 | ;; Make news-reply-yank-original work on the current article. | |
166 | (setq mail-reply-buffer artbuf) | |
167 | (erase-buffer) | |
168 | (if gnus-interactive-post | |
169 | ;; Newsgroups, subject and distribution are asked for. | |
170 | ;; Suggested by yuki@flab.fujitsu.junet. | |
171 | (progn | |
172 | ;; Subscribed newsgroup names are required for | |
173 | ;; completing read of newsgroup. | |
174 | (or gnus-newsrc-assoc | |
175 | (gnus-read-newsrc-file)) | |
176 | ;; Which do you like? (UMERIN) | |
177 | ;; (setq newsgroups (read-string "Newsgroups: " "general")) | |
178 | (or newsgroups ;Use the default newsgroup. | |
a082d8bd RS |
179 | (let (group) |
180 | (while (not | |
181 | (string= | |
182 | (setq group | |
183 | (completing-read "Newsgroup: " | |
184 | gnus-newsrc-assoc | |
185 | nil 'require-match)) | |
186 | "")) | |
187 | (or followup-to (setq followup-to group)) | |
188 | (if newsgroups | |
189 | (setq newsgroups (concat newsgroups "," group)) | |
190 | (setq newsgroups group))))) | |
2f790b20 | 191 | (setq subject (read-string "Subject: ")) |
b027f415 RS |
192 | ;; Choose a distribution from gnus-distribution-list. |
193 | ;; completing-read should not be used with | |
194 | ;; 'require-match functionality in order to allow use | |
195 | ;; of unknow distribution. | |
2368506d | 196 | (gnus-read-distributions-file) |
2f790b20 | 197 | (setq distribution |
b027f415 RS |
198 | (if (consp gnus-distribution-list) |
199 | (completing-read "Distribution: " | |
200 | gnus-distribution-list | |
201 | nil nil ;Never 'require-match | |
202 | distribution ;Default distribution. | |
203 | ) | |
204 | (read-string "Distribution: "))) | |
205 | ;; Empty string is okay. | |
2f790b20 JB |
206 | ;;(if (string-equal distribution "") |
207 | ;; (setq distribution nil)) | |
208 | )) | |
209 | (news-setup () subject () newsgroups artbuf) | |
210 | ;; Make sure the article is posted by GNUS. | |
211 | ;;(mail-position-on-field "Posting-Software") | |
212 | ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") | |
213 | ;; Insert Distribution: field. | |
214 | ;; Suggested by ichikawa@flab.fujitsu.junet. | |
215 | (mail-position-on-field "Distribution") | |
b027f415 | 216 | (insert (or distribution "")) |
a082d8bd RS |
217 | ;; Add Followup-To header |
218 | (if followup-to | |
219 | (progn | |
220 | (mail-position-on-field "Followup-To") | |
221 | (insert followup-to))) | |
2f790b20 JB |
222 | ;; Handle author copy using FCC field. |
223 | (if gnus-author-copy | |
224 | (progn | |
225 | (mail-position-on-field "FCC") | |
226 | (insert gnus-author-copy))) | |
227 | (if gnus-interactive-post | |
228 | ;; All fields are filled in. | |
229 | (goto-char (point-max)) | |
230 | ;; Move point to Newsgroup: field. | |
231 | (goto-char (point-min)) | |
232 | (end-of-line)) | |
233 | )) | |
234 | (message ""))) | |
235 | ||
236 | (defun gnus-news-reply (&optional yank) | |
237 | "Compose and post a reply (aka a followup) to the current article on USENET. | |
238 | While composing the followup, use \\[news-reply-yank-original] to yank the | |
239 | original message into it." | |
240 | (interactive) | |
241 | (if (or (not gnus-novice-user) | |
242 | (y-or-n-p "Are you sure you want to followup to all of USENET? ")) | |
243 | (let (from cc subject date to followup-to newsgroups message-of | |
244 | references distribution message-id | |
245 | (artbuf (current-buffer))) | |
246 | (save-restriction | |
247 | (and (not (zerop (buffer-size))) | |
248 | ;;(equal major-mode 'news-mode) | |
b027f415 | 249 | (equal major-mode 'gnus-article-mode) |
2f790b20 JB |
250 | (progn |
251 | ;; (news-show-all-headers) | |
b027f415 | 252 | (gnus-article-show-all-headers) |
2f790b20 JB |
253 | (narrow-to-region (point-min) |
254 | (progn (goto-char (point-min)) | |
255 | (search-forward "\n\n") | |
256 | (point))))) | |
257 | (setq from (mail-fetch-field "from")) | |
18260534 RS |
258 | ;; Get reply-to working corrrectly for gnus-auto-mail-to-author (jpm) |
259 | (setq reply-to (mail-fetch-field "reply-to")) | |
2f790b20 JB |
260 | (setq news-reply-yank-from from) |
261 | (setq subject (mail-fetch-field "subject")) | |
262 | (setq date (mail-fetch-field "date")) | |
263 | (setq followup-to (mail-fetch-field "followup-to")) | |
264 | ;; Ignore Followup-To: poster. | |
265 | (if (or (null gnus-use-followup-to) ;Ignore followup-to: field. | |
266 | (string-equal "" followup-to) ;Bogus header. | |
267 | (string-equal "poster" followup-to)) | |
268 | (setq followup-to nil)) | |
269 | (setq newsgroups (or followup-to (mail-fetch-field "newsgroups"))) | |
270 | (setq references (mail-fetch-field "references")) | |
271 | (setq distribution (mail-fetch-field "distribution")) | |
272 | (setq message-id (mail-fetch-field "message-id")) | |
273 | (setq news-reply-yank-message-id message-id)) | |
274 | (pop-to-buffer gnus-post-news-buffer) | |
275 | (news-reply-mode) | |
276 | (gnus-overload-functions) | |
277 | (if (and (buffer-modified-p) | |
278 | (> (buffer-size) 0) | |
279 | (not (y-or-n-p "Unsent article being composed; erase it? "))) | |
280 | ;; Continue composition. | |
281 | ;; Make news-reply-yank-original work on current article. | |
282 | (setq mail-reply-buffer artbuf) | |
283 | (erase-buffer) | |
284 | (and subject | |
285 | (setq subject | |
286 | (concat "Re: " (gnus-simplify-subject subject 're-only)))) | |
287 | (and from | |
288 | (progn | |
289 | (let ((stop-pos | |
290 | (string-match " *at \\| *@ \\| *(\\| *<" from))) | |
291 | (setq message-of | |
292 | (concat | |
293 | (if stop-pos (substring from 0 stop-pos) from) | |
294 | "'s message of " | |
295 | date))))) | |
296 | (news-setup nil subject message-of newsgroups artbuf) | |
297 | (if followup-to | |
298 | (progn (news-reply-followup-to) | |
299 | (insert followup-to))) | |
300 | ;; Fold long references line to follow RFC1036. | |
301 | (mail-position-on-field "References") | |
302 | (let ((begin (point)) | |
303 | (fill-column 79) | |
304 | (fill-prefix "\t")) | |
305 | (if references | |
306 | (insert references)) | |
307 | (if (and references message-id) | |
308 | (insert " ")) | |
309 | (if message-id | |
310 | (insert message-id)) | |
311 | ;; The region must end with a newline to fill the region | |
312 | ;; without inserting extra newline. | |
313 | (fill-region-as-paragraph begin (1+ (point)))) | |
314 | ;; Make sure the article is posted by GNUS. | |
315 | ;;(mail-position-on-field "Posting-Software") | |
316 | ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs") | |
317 | ;; Distribution must be the same as original article. | |
318 | (mail-position-on-field "Distribution") | |
319 | (insert (or distribution "")) | |
320 | ;; Handle author copy using FCC field. | |
321 | (if gnus-author-copy | |
322 | (progn | |
323 | (mail-position-on-field "FCC") | |
324 | (insert gnus-author-copy))) | |
b027f415 | 325 | ;; Insert To: FROM field, which is expected to mail the |
18260534 RS |
326 | ;; message to the author of the article too. Use Reply-To |
327 | ;; field like gnus-mail-reply-using-m* (jpm). | |
328 | (if (and gnus-auto-mail-to-author (or reply-to from)) | |
b027f415 RS |
329 | (progn |
330 | (goto-char (point-min)) | |
18260534 | 331 | (insert "To: " (or reply-to from) "\n"))) |
2f790b20 JB |
332 | (goto-char (point-max))) |
333 | ;; Yank original article automatically. | |
334 | (if yank | |
335 | (let ((last (point))) | |
b027f415 RS |
336 | ;;(goto-char (point-max)) |
337 | ;; Insert at current point. | |
2f790b20 JB |
338 | (news-reply-yank-original nil) |
339 | (goto-char last))) | |
340 | ) | |
341 | (message ""))) | |
342 | ||
343 | (defun gnus-inews-news () | |
344 | "Send a news message." | |
345 | (interactive) | |
346 | (let* ((case-fold-search nil) | |
347 | (server-running (gnus-server-opened))) | |
348 | (save-excursion | |
b027f415 | 349 | ;; Connect to default NNTP server if necessary. |
2f790b20 JB |
350 | ;; Suggested by yuki@flab.fujitsu.junet. |
351 | (gnus-start-news-server) ;Use default server. | |
352 | ;; NNTP server must be opened before current buffer is modified. | |
353 | (widen) | |
354 | (goto-char (point-min)) | |
355 | (run-hooks 'news-inews-hook) | |
738f9104 RS |
356 | (save-restriction |
357 | (narrow-to-region | |
358 | (point-min) | |
359 | (progn | |
360 | (goto-char (point-min)) | |
361 | (search-forward (concat "\n" mail-header-separator "\n")) | |
362 | (point))) | |
363 | ||
364 | ;; Correct newsgroups field: change sequence of spaces to comma and | |
365 | ;; eliminate spaces around commas. Eliminate imbedded line breaks. | |
366 | (goto-char (point-min)) | |
367 | (if (search-forward-regexp "^Newsgroups: +" nil t) | |
368 | (save-restriction | |
369 | (narrow-to-region | |
370 | (point) | |
371 | (if (re-search-forward "^[^ \t]" nil 'end) | |
372 | (match-beginning 0) | |
373 | (point-max))) | |
b027f415 | 374 | (goto-char (point-min)) |
738f9104 RS |
375 | (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) |
376 | (goto-char (point-min)) | |
377 | (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",") | |
378 | )) | |
379 | ||
380 | ;; Mail the message too if To: or Cc: exists. | |
381 | (if (or (mail-fetch-field "to" nil t) | |
382 | (mail-fetch-field "cc" nil t)) | |
383 | (if gnus-mail-send-method | |
384 | (progn | |
385 | (message "Sending via mail...") | |
386 | (widen) | |
387 | (funcall gnus-mail-send-method) | |
388 | (message "Sending via mail... done")) | |
389 | (ding) | |
390 | (message "No mailer defined. To: and/or Cc: fields ignored.") | |
391 | (sit-for 1)))) | |
392 | ||
b027f415 | 393 | ;; Send to NNTP server. |
2f790b20 | 394 | (message "Posting to USENET...") |
2f790b20 JB |
395 | (if (gnus-inews-article) |
396 | (message "Posting to USENET... done") | |
397 | ;; We cannot signal an error. | |
398 | (ding) (message "Article rejected: %s" (gnus-status-message))) | |
2f790b20 JB |
399 | (set-buffer-modified-p nil)) |
400 | ;; If NNTP server is opened by gnus-inews-news, close it by myself. | |
401 | (or server-running | |
402 | (gnus-close-server)) | |
403 | (and (fboundp 'bury-buffer) (bury-buffer)) | |
404 | ;; Restore last window configuration. | |
405 | (and gnus-winconf-post-news | |
406 | (set-window-configuration gnus-winconf-post-news)) | |
407 | (setq gnus-winconf-post-news nil) | |
408 | )) | |
409 | ||
410 | (defun gnus-cancel-news () | |
411 | "Cancel an article you posted." | |
412 | (interactive) | |
413 | (if (yes-or-no-p "Do you really want to cancel this article? ") | |
414 | (let ((from nil) | |
415 | (newsgroups nil) | |
416 | (message-id nil) | |
417 | (distribution nil)) | |
418 | (save-excursion | |
419 | ;; Get header info. from original article. | |
420 | (save-restriction | |
b027f415 | 421 | (gnus-article-show-all-headers) |
2f790b20 | 422 | (goto-char (point-min)) |
b027f415 | 423 | (search-forward "\n\n" nil 'move) |
2f790b20 JB |
424 | (narrow-to-region (point-min) (point)) |
425 | (setq from (mail-fetch-field "from")) | |
426 | (setq newsgroups (mail-fetch-field "newsgroups")) | |
427 | (setq message-id (mail-fetch-field "message-id")) | |
428 | (setq distribution (mail-fetch-field "distribution"))) | |
429 | ;; Verify if the article is absolutely user's by comparing | |
430 | ;; user id with value of its From: field. | |
431 | (if (not | |
432 | (string-equal | |
433 | (downcase (mail-strip-quoted-names from)) | |
434 | (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) | |
435 | (progn | |
b027f415 | 436 | (ding) (message "This article is not yours.")) |
2f790b20 | 437 | ;; Make control article. |
b027f415 | 438 | (set-buffer (get-buffer-create " *GNUS-canceling*")) |
77af5293 | 439 | (buffer-disable-undo (current-buffer)) |
2f790b20 JB |
440 | (erase-buffer) |
441 | (insert "Newsgroups: " newsgroups "\n" | |
442 | "Subject: cancel " message-id "\n" | |
443 | "Control: cancel " message-id "\n" | |
b027f415 RS |
444 | ;; We should not use the first value of |
445 | ;; `gnus-distribution-list' as default value, | |
2f790b20 JB |
446 | ;; because distribution must be as same as original |
447 | ;; article. | |
448 | "Distribution: " (or distribution "") "\n" | |
b027f415 | 449 | mail-header-separator "\n" |
2f790b20 | 450 | ) |
2f790b20 JB |
451 | ;; Send the control article to NNTP server. |
452 | (message "Canceling your article...") | |
b027f415 | 453 | (if (gnus-inews-article) |
2f790b20 JB |
454 | (message "Canceling your article... done") |
455 | (ding) (message "Failed to cancel your article")) | |
b027f415 | 456 | ;; Kill the article buffer. |
2f790b20 JB |
457 | (kill-buffer (current-buffer)) |
458 | ))) | |
459 | )) | |
460 | ||
461 | \f | |
462 | ;;; Lowlevel inews interface | |
463 | ||
464 | (defun gnus-inews-article () | |
b027f415 RS |
465 | "Post an article in current buffer using NNTP protocol." |
466 | (let ((artbuf (current-buffer)) | |
2f790b20 JB |
467 | (tmpbuf (get-buffer-create " *GNUS-posting*"))) |
468 | (save-excursion | |
469 | (set-buffer tmpbuf) | |
77af5293 | 470 | (buffer-disable-undo (current-buffer)) |
2f790b20 JB |
471 | (erase-buffer) |
472 | (insert-buffer-substring artbuf) | |
b027f415 RS |
473 | ;; Remove the header separator. |
474 | (goto-char (point-min)) | |
475 | (search-forward (concat "\n" mail-header-separator "\n")) | |
476 | (replace-match "\n\n") | |
477 | (goto-char (point-max)) | |
478 | ;; require a newline at the end for inews to append .signature to | |
479 | (or (= (preceding-char) ?\n) | |
480 | (insert ?\n)) | |
481 | ;; This hook may insert a signature. | |
482 | (run-hooks 'gnus-prepare-article-hook) | |
483 | ;; Prepare article headers. All message body such as signature | |
484 | ;; must be inserted before Lines: field is prepared. | |
2f790b20 JB |
485 | (save-restriction |
486 | (goto-char (point-min)) | |
487 | (search-forward "\n\n") | |
488 | (narrow-to-region (point-min) (point)) | |
b027f415 RS |
489 | (gnus-inews-insert-headers)) |
490 | ;; Run final inews hooks. This hook may do FCC. | |
491 | ;; The article must be saved before being posted because | |
492 | ;; `gnus-request-post' modifies the buffer. | |
493 | (run-hooks 'gnus-inews-article-hook) | |
2f790b20 JB |
494 | ;; Post an article to NNTP server. |
495 | ;; Return NIL if post failed. | |
496 | (prog1 | |
497 | (gnus-request-post) | |
498 | (kill-buffer (current-buffer))) | |
499 | ))) | |
500 | ||
b027f415 RS |
501 | (defun gnus-inews-insert-headers () |
502 | "Prepare article headers. | |
503 | Fields already prepared in the buffer are not modified. | |
504 | Fields in gnus-required-headers will be generated." | |
505 | (save-excursion | |
506 | (let ((date (gnus-inews-date)) | |
507 | (message-id (gnus-inews-message-id)) | |
508 | (organization (gnus-inews-organization))) | |
509 | (goto-char (point-min)) | |
510 | (or (mail-fetch-field "path") | |
511 | (and (memq 'Path gnus-required-headers) | |
512 | (insert "Path: " (gnus-inews-path) "\n"))) | |
513 | (or (mail-fetch-field "from") | |
514 | (and (memq 'From gnus-required-headers) | |
515 | (insert "From: " (gnus-inews-user-name) "\n"))) | |
516 | ;; If there is no subject, make Subject: field. | |
517 | (or (mail-fetch-field "subject") | |
518 | (and (memq 'Subject gnus-required-headers) | |
519 | (insert "Subject: \n"))) | |
520 | ;; If there is no newsgroups, make Newsgroups: field. | |
521 | (or (mail-fetch-field "newsgroups") | |
522 | (and (memq 'Newsgroups gnus-required-headers) | |
523 | (insert "Newsgroups: \n"))) | |
524 | (or (mail-fetch-field "message-id") | |
525 | (and message-id | |
526 | (memq 'Message-ID gnus-required-headers) | |
527 | (insert "Message-ID: " message-id "\n"))) | |
528 | (or (mail-fetch-field "date") | |
529 | (and date | |
530 | (memq 'Date gnus-required-headers) | |
531 | (insert "Date: " date "\n"))) | |
532 | ;; Optional fields in RFC977 and RFC1036 | |
533 | (or (mail-fetch-field "organization") | |
534 | (and organization | |
535 | (memq 'Organization gnus-required-headers) | |
536 | (let ((begin (point)) | |
537 | (fill-column 79) | |
538 | (fill-prefix "\t")) | |
539 | (insert "Organization: " organization "\n") | |
540 | (fill-region-as-paragraph begin (point))))) | |
541 | (or (mail-fetch-field "distribution") | |
542 | (and (memq 'Distribution gnus-required-headers) | |
543 | (insert "Distribution: \n"))) | |
544 | (or (mail-fetch-field "lines") | |
545 | (and (memq 'Lines gnus-required-headers) | |
546 | (insert "Lines: " (gnus-inews-lines) "\n"))) | |
547 | ))) | |
548 | ||
549 | \f | |
550 | ;; Utility functions. | |
551 | ||
552 | (defun gnus-inews-insert-signature () | |
553 | "Insert signature file in current article buffer. | |
554 | If there is a file named .signature-DISTRIBUTION, it is used instead | |
555 | of usual .signature when the distribution of the article is | |
556 | DISTRIBUTION. Set the variable to nil to prevent appending the | |
557 | signature file automatically. | |
558 | Signature file is specified by the variable gnus-signature-file." | |
559 | (save-excursion | |
560 | (save-restriction | |
561 | ;; Change signature file by distribution. | |
562 | ;; Suggested by hyoko@flab.fujitsu.co.jp. | |
563 | (let ((signature | |
564 | (if gnus-signature-file | |
565 | (expand-file-name gnus-signature-file nil))) | |
566 | (distribution nil)) | |
567 | (goto-char (point-min)) | |
568 | (search-forward "\n\n") | |
569 | (narrow-to-region (point-min) (point)) | |
570 | (setq distribution (mail-fetch-field "distribution")) | |
571 | (widen) | |
572 | (if signature | |
573 | (progn | |
574 | (if (file-exists-p (concat signature "-" distribution)) | |
575 | (setq signature (concat signature "-" distribution))) | |
576 | ;; Insert signature. | |
577 | (if (file-exists-p signature) | |
578 | (progn | |
579 | (goto-char (point-max)) | |
77af5293 | 580 | (insert "-- \n") |
b027f415 RS |
581 | (insert-file-contents signature))) |
582 | )))))) | |
583 | ||
2f790b20 | 584 | (defun gnus-inews-do-fcc () |
b027f415 RS |
585 | "Process FCC: fields in current article buffer. |
586 | Unless the first character of the field is `|', the article is saved | |
587 | to the specified file using the function specified by the variable | |
588 | gnus-author-copy-saver. The default function rmail-output saves in | |
589 | Unix mailbox format. | |
590 | If the first character is `|', the contents of the article is send to | |
591 | a program specified by the rest of the value." | |
2f790b20 JB |
592 | (let ((fcc-list nil) |
593 | (fcc-file nil) | |
594 | (case-fold-search t)) ;Should ignore case. | |
595 | (save-excursion | |
596 | (save-restriction | |
b027f415 RS |
597 | (goto-char (point-min)) |
598 | (search-forward "\n\n") | |
599 | (narrow-to-region (point-min) (point)) | |
2f790b20 JB |
600 | (goto-char (point-min)) |
601 | (while (re-search-forward "^FCC:[ \t]*" nil t) | |
b027f415 RS |
602 | (setq fcc-list |
603 | (cons (buffer-substring | |
604 | (point) | |
605 | (progn | |
606 | (end-of-line) | |
607 | (skip-chars-backward " \t") | |
608 | (point))) | |
609 | fcc-list)) | |
2f790b20 JB |
610 | (delete-region (match-beginning 0) |
611 | (progn (forward-line 1) (point)))) | |
612 | ;; Process FCC operations. | |
613 | (widen) | |
614 | (while fcc-list | |
615 | (setq fcc-file (car fcc-list)) | |
616 | (setq fcc-list (cdr fcc-list)) | |
617 | (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) | |
618 | (let ((program (substring fcc-file | |
619 | (match-beginning 1) (match-end 1)))) | |
620 | ;; Suggested by yuki@flab.fujitsu.junet. | |
621 | ;; Send article to named program. | |
622 | (call-process-region (point-min) (point-max) shell-file-name | |
623 | nil nil nil "-c" program) | |
624 | )) | |
625 | (t | |
626 | ;; Suggested by hyoko@flab.fujitsu.junet. | |
627 | ;; Save article in Unix mail format by default. | |
b7d52f8e RS |
628 | (if (and gnus-author-copy-saver |
629 | (not (eq gnus-author-copy-saver 'rmail-output))) | |
49132687 | 630 | (funcall gnus-author-copy-saver fcc-file) |
ee1323a2 RS |
631 | (if (and (file-readable-p fcc-file) |
632 | (mail-file-babyl-p fcc-file)) | |
49132687 RS |
633 | (gnus-output-to-rmail fcc-file) |
634 | (rmail-output fcc-file 1 t t))) | |
2f790b20 JB |
635 | )) |
636 | ) | |
637 | )) | |
638 | )) | |
639 | ||
2f790b20 JB |
640 | (defun gnus-inews-path () |
641 | "Return uucp path." | |
642 | (let ((login-name (gnus-inews-login-name))) | |
643 | (cond ((null gnus-use-generic-path) | |
644 | (concat gnus-nntp-server "!" login-name)) | |
645 | ((stringp gnus-use-generic-path) | |
646 | ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. | |
647 | (concat gnus-use-generic-path "!" login-name)) | |
648 | (t login-name)) | |
649 | )) | |
650 | ||
651 | (defun gnus-inews-user-name () | |
0086b593 RS |
652 | "Return user's network address as `NAME@DOMAIN (FULLNAME)'." |
653 | (let ((full-name (gnus-inews-full-name))) | |
654 | (concat (if (or gnus-user-login-name gnus-use-generic-from | |
655 | gnus-local-domain (getenv "DOMAINNAME")) | |
656 | (concat (gnus-inews-login-name) "@" | |
657 | (gnus-inews-domain-name gnus-use-generic-from)) | |
658 | user-mail-address) | |
2f790b20 JB |
659 | ;; User's full name. |
660 | (cond ((string-equal full-name "") "") | |
661 | ((string-equal full-name "&") ;Unix hack. | |
662 | (concat " (" login-name ")")) | |
663 | (t | |
664 | (concat " (" full-name ")"))) | |
665 | ))) | |
666 | ||
667 | (defun gnus-inews-login-name () | |
668 | "Return user login name. | |
157acde5 KH |
669 | Got from the variable `gnus-user-login-name' and the function |
670 | `user-login-name'." | |
671 | (or gnus-user-login-name (user-login-name))) | |
2f790b20 JB |
672 | |
673 | (defun gnus-inews-full-name () | |
674 | "Return user full name. | |
0086b593 RS |
675 | Got from the variable `gnus-user-full-name', the environment variable |
676 | NAME, and the function `user-full-name'." | |
2f790b20 JB |
677 | (or gnus-user-full-name |
678 | (getenv "NAME") (user-full-name))) | |
679 | ||
680 | (defun gnus-inews-domain-name (&optional genericfrom) | |
681 | "Return user's domain name. | |
682 | If optional argument GENERICFROM is a string, use it as the domain | |
683 | name; if it is non-nil, strip of local host name from the domain name. | |
684 | If the function `system-name' returns full internet name and the | |
685 | domain is undefined, the domain name is got from it." | |
0b431400 RS |
686 | (and (null gnus-local-domain) |
687 | (boundp 'gnus-your-domain) | |
688 | (setq gnus-local-domain gnus-your-domain)) | |
689 | (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) | |
690 | (let ((domain (or (if (stringp genericfrom) genericfrom) | |
691 | (getenv "DOMAINNAME") | |
692 | gnus-local-domain | |
693 | ;; Function `system-name' may return full internet name. | |
694 | ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>. | |
695 | (if (string-match "\\." (system-name)) | |
696 | (substring (system-name) (match-end 0))) | |
697 | (read-string "Domain name (no host): "))) | |
698 | (host (or (if (string-match "\\." (system-name)) | |
699 | (substring (system-name) 0 (match-beginning 0))) | |
700 | (system-name)))) | |
701 | (if (string-equal "." (substring domain 0 1)) | |
702 | (setq domain (substring domain 1))) | |
703 | ;; Support GENERICFROM as same as standard Bnews system. | |
704 | ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. | |
705 | (cond ((null genericfrom) | |
706 | (concat host "." domain)) | |
707 | ;;((stringp genericfrom) genericfrom) | |
708 | (t domain))) | |
709 | (substring user-mail-address (1+ (string-match "@" user-mail-address))))) | |
2f790b20 JB |
710 | |
711 | (defun gnus-inews-message-id () | |
712 | "Generate unique Message-ID for user." | |
713 | ;; Message-ID should not contain a slash and should be terminated by | |
714 | ;; a number. I don't know the reason why it is so. | |
715 | (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">")) | |
716 | ||
717 | (defun gnus-inews-unique-id () | |
718 | "Generate unique ID from user name and current time." | |
719 | (let ((date (current-time-string)) | |
720 | (name (gnus-inews-login-name))) | |
721 | (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)" | |
722 | date) | |
723 | (concat (upcase name) "." | |
724 | (substring date (match-beginning 6) (match-end 6)) ;Year | |
725 | (substring date (match-beginning 1) (match-end 1)) ;Month | |
726 | (substring date (match-beginning 2) (match-end 2)) ;Day | |
727 | (substring date (match-beginning 3) (match-end 3)) ;Hour | |
728 | (substring date (match-beginning 4) (match-end 4)) ;Minute | |
729 | (substring date (match-beginning 5) (match-end 5)) ;Second | |
730 | ) | |
731 | (error "Cannot understand current-time-string: %s." date)) | |
732 | )) | |
733 | ||
1ea40ac2 RS |
734 | (defun gnus-current-time-zone (time) |
735 | "The local time zone in effect at TIME, or nil if not known." | |
9723a15c | 736 | (let ((z (and (fboundp 'current-time-zone) (current-time-zone time)))) |
1ea40ac2 RS |
737 | (if (and z (car z)) z gnus-local-timezone))) |
738 | ||
2f790b20 | 739 | (defun gnus-inews-date () |
b027f415 | 740 | "Date string of today. |
1ea40ac2 RS |
741 | If `current-time-zone' works, or if `gnus-local-timezone' is set correctly, |
742 | this yields a date that conforms to RFC 822. Otherwise a buggy date will | |
743 | be generated; this might work with some older news servers." | |
744 | (let* ((now (and (fboundp 'current-time) (current-time))) | |
745 | (zone (gnus-current-time-zone now))) | |
746 | (if zone | |
747 | (gnus-inews-valid-date now zone) | |
748 | ;; No timezone info. | |
749 | (gnus-inews-buggy-date now)))) | |
750 | ||
751 | (defun gnus-inews-valid-date (&optional time zone) | |
752 | "A date string that represents TIME and conforms to the Usenet standard. | |
753 | TIME is optional and defaults to the current time. | |
754 | Some older versions of Emacs always act as if TIME is nil. | |
755 | The optional argument ZONE specifies the local time zone (default GMT)." | |
b027f415 | 756 | (timezone-make-date-arpa-standard |
1ea40ac2 RS |
757 | (if (fboundp 'current-time) |
758 | (current-time-string time) | |
759 | (current-time-string)) | |
760 | zone "GMT")) | |
761 | ||
762 | (defun gnus-inews-buggy-date (&optional time) | |
c1293b1b | 763 | "A buggy date string that represents TIME. |
1ea40ac2 RS |
764 | TIME is optional and defaults to the current time. |
765 | Some older versions of Emacs always act as if TIME is nil." | |
766 | (let ((date (if (fboundp 'current-time) | |
767 | (current-time-string time) | |
768 | (current-time-string)))) | |
2f790b20 JB |
769 | (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" |
770 | date) | |
771 | (concat (substring date (match-beginning 2) (match-end 2)) ;Day | |
772 | " " | |
773 | (substring date (match-beginning 1) (match-end 1)) ;Month | |
774 | " " | |
775 | (substring date (match-beginning 4) (match-end 4)) ;Year | |
776 | " " | |
777 | (substring date (match-beginning 3) (match-end 3))) ;Time | |
778 | (error "Cannot understand current-time-string: %s." date)) | |
779 | )) | |
780 | ||
781 | (defun gnus-inews-organization () | |
782 | "Return user's organization. | |
783 | The ORGANIZATION environment variable is used if defined. | |
b027f415 | 784 | If not, the variable gnus-local-organization is used instead. |
2f790b20 JB |
785 | If the value begins with a slash, it is taken as the name of a file |
786 | containing the organization." | |
787 | ;; The organization must be got in this order since the ORGANIZATION | |
788 | ;; environment variable is intended for user specific while | |
b027f415 RS |
789 | ;; gnus-local-organization is for machine or organization specific. |
790 | ||
791 | ;; Note: compatibility hack. This will be removed in the next version. | |
792 | (and (null gnus-local-organization) | |
793 | (boundp 'gnus-your-organization) | |
794 | (setq gnus-local-organization gnus-your-organization)) | |
795 | ;; End of compatibility hack. | |
796 | (let* ((private-file (expand-file-name "~/.organization" nil)) | |
797 | (organization (or (getenv "ORGANIZATION") | |
798 | gnus-local-organization | |
799 | private-file))) | |
2f790b20 | 800 | (and (stringp organization) |
9723a15c | 801 | (> (length organization) 0) |
2f790b20 JB |
802 | (string-equal (substring organization 0 1) "/") |
803 | ;; Get it from the user and system file. | |
804 | ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath). | |
805 | (let ((dist (mail-fetch-field "distribution"))) | |
806 | (setq organization | |
807 | (cond ((file-exists-p (concat organization "-" dist)) | |
808 | (concat organization "-" dist)) | |
809 | ((file-exists-p organization) organization) | |
810 | ((file-exists-p gnus-organization-file) | |
811 | gnus-organization-file) | |
812 | (t organization))) | |
813 | )) | |
814 | (cond ((not (stringp organization)) nil) | |
815 | ((and (string-equal (substring organization 0 1) "/") | |
816 | (file-exists-p organization)) | |
817 | ;; If the first character is `/', assume it is the name of | |
818 | ;; a file containing the organization. | |
819 | (save-excursion | |
820 | (let ((tmpbuf (get-buffer-create " *GNUS organization*"))) | |
821 | (set-buffer tmpbuf) | |
822 | (erase-buffer) | |
823 | (insert-file-contents organization) | |
824 | (prog1 (buffer-string) | |
825 | (kill-buffer tmpbuf)) | |
826 | ))) | |
b027f415 | 827 | ((string-equal organization private-file) nil) ;No such file |
2f790b20 JB |
828 | (t organization)) |
829 | )) | |
49116ac0 | 830 | |
b027f415 RS |
831 | (defun gnus-inews-lines () |
832 | "Count the number of lines and return numeric string." | |
833 | (save-excursion | |
834 | (save-restriction | |
835 | (widen) | |
836 | (goto-char (point-min)) | |
837 | (search-forward "\n\n" nil 'move) | |
838 | (int-to-string (count-lines (point) (point-max)))))) | |
839 | ||
49116ac0 | 840 | (provide 'gnuspost) |
1a06eabd ER |
841 | |
842 | ;;; gnuspost.el ends here |