660
|
1 ;;; gnuspost.el --- post news commands for GNUS newsreader
|
|
2
|
7300
|
3 ;; Copyright (C) 1989, 1990, 1993, 1994 Free Software Foundation, Inc.
|
846
|
4
|
8100
|
5 ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
|
811
|
6 ;; Keywords: news
|
807
|
7
|
267
|
8 ;; This file is part of GNU Emacs.
|
|
9
|
711
|
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
|
807
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
711
|
13 ;; any later version.
|
267
|
14
|
711
|
15 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
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.
|
267
|
23
|
807
|
24 ;;; Code:
|
|
25
|
267
|
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")
|
2843
|
35 (autoload 'timezone-make-date-arpa-standard "timezone")
|
267
|
36
|
2843
|
37 ;;; Post news commands of GNUS Group Mode and Summary Mode
|
267
|
38
|
2843
|
39 (defun gnus-group-post-news ()
|
267
|
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)))
|
2843
|
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)))
|
267
|
55
|
2843
|
56 (defun gnus-summary-post-news ()
|
267
|
57 "Post an article."
|
|
58 (interactive)
|
2843
|
59 (gnus-summary-select-article t nil)
|
267
|
60 ;; Save window configuration.
|
|
61 (setq gnus-winconf-post-news (current-window-configuration))
|
|
62 (unwind-protect
|
|
63 (progn
|
2843
|
64 (switch-to-buffer gnus-article-buffer)
|
267
|
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.
|
2843
|
73 (bury-buffer gnus-article-buffer))
|
267
|
74
|
2843
|
75 (defun gnus-summary-followup (yank)
|
267
|
76 "Post a reply article.
|
|
77 If prefix argument YANK is non-nil, original article is yanked automatically."
|
|
78 (interactive "P")
|
2843
|
79 (gnus-summary-select-article t nil)
|
267
|
80 ;; Check Followup-To: poster.
|
2843
|
81 (set-buffer gnus-article-buffer)
|
267
|
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.
|
2843
|
87 (gnus-summary-reply yank)
|
267
|
88 ;; Save window configuration.
|
|
89 (setq gnus-winconf-post-news (current-window-configuration))
|
|
90 (unwind-protect
|
|
91 (progn
|
2843
|
92 (switch-to-buffer gnus-article-buffer)
|
267
|
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.
|
2843
|
101 (bury-buffer gnus-article-buffer)))
|
267
|
102
|
2843
|
103 (defun gnus-summary-followup-with-original ()
|
267
|
104 "Post a reply article with original article."
|
|
105 (interactive)
|
2843
|
106 (gnus-summary-followup t))
|
267
|
107
|
2843
|
108 (defun gnus-summary-cancel-article ()
|
267
|
109 "Cancel an article you posted."
|
|
110 (interactive)
|
2843
|
111 (gnus-summary-select-article t nil)
|
|
112 (gnus-eval-in-buffer-window gnus-article-buffer
|
267
|
113 (gnus-cancel-news)))
|
|
114
|
|
115
|
|
116 ;;; Post a News using NNTP
|
|
117
|
|
118 ;;;###autoload
|
9349
|
119 (defalias 'sendnews 'gnus-post-news)
|
2843
|
120
|
267
|
121 ;;;###autoload
|
9349
|
122 (defalias 'postnews 'gnus-post-news)
|
2843
|
123
|
267
|
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.
|
2843
|
133 (if (eq major-mode 'gnus-article-mode) gnus-newsgroup-name))
|
267
|
134 (subject nil)
|
2843
|
135 ;; Get default distribution.
|
7517
|
136 (distribution (car gnus-local-distributions))
|
|
137 (followup-to nil))
|
2843
|
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.
|
267
|
145 (save-restriction
|
|
146 (and (not (zerop (buffer-size)))
|
|
147 ;;(equal major-mode 'news-mode)
|
2843
|
148 (equal major-mode 'gnus-article-mode)
|
267
|
149 (progn
|
|
150 ;;(news-show-all-headers)
|
2843
|
151 (gnus-article-show-all-headers)
|
267
|
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.
|
7517
|
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)))))
|
267
|
191 (setq subject (read-string "Subject: "))
|
2843
|
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.
|
5295
|
196 (gnus-read-distributions-file)
|
267
|
197 (setq distribution
|
2843
|
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.
|
267
|
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")
|
2843
|
216 (insert (or distribution ""))
|
7517
|
217 ;; Add Followup-To header
|
|
218 (if followup-to
|
|
219 (progn
|
|
220 (mail-position-on-field "Followup-To")
|
|
221 (insert followup-to)))
|
267
|
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)
|
2843
|
249 (equal major-mode 'gnus-article-mode)
|
267
|
250 (progn
|
|
251 ;; (news-show-all-headers)
|
2843
|
252 (gnus-article-show-all-headers)
|
267
|
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"))
|
5397
|
258 ;; Get reply-to working corrrectly for gnus-auto-mail-to-author (jpm)
|
|
259 (setq reply-to (mail-fetch-field "reply-to"))
|
267
|
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)))
|
2843
|
325 ;; Insert To: FROM field, which is expected to mail the
|
5397
|
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))
|
2843
|
329 (progn
|
|
330 (goto-char (point-min))
|
5397
|
331 (insert "To: " (or reply-to from) "\n")))
|
267
|
332 (goto-char (point-max)))
|
|
333 ;; Yank original article automatically.
|
|
334 (if yank
|
|
335 (let ((last (point)))
|
2843
|
336 ;;(goto-char (point-max))
|
|
337 ;; Insert at current point.
|
267
|
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
|
2843
|
349 ;; Connect to default NNTP server if necessary.
|
267
|
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)
|
8134
|
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)))
|
2843
|
374 (goto-char (point-min))
|
8134
|
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
|
2843
|
393 ;; Send to NNTP server.
|
267
|
394 (message "Posting to USENET...")
|
|
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)))
|
|
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
|
2843
|
421 (gnus-article-show-all-headers)
|
267
|
422 (goto-char (point-min))
|
2843
|
423 (search-forward "\n\n" nil 'move)
|
267
|
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
|
2843
|
436 (ding) (message "This article is not yours."))
|
267
|
437 ;; Make control article.
|
2843
|
438 (set-buffer (get-buffer-create " *GNUS-canceling*"))
|
12166
|
439 (buffer-disable-undo (current-buffer))
|
267
|
440 (erase-buffer)
|
|
441 (insert "Newsgroups: " newsgroups "\n"
|
|
442 "Subject: cancel " message-id "\n"
|
|
443 "Control: cancel " message-id "\n"
|
2843
|
444 ;; We should not use the first value of
|
|
445 ;; `gnus-distribution-list' as default value,
|
267
|
446 ;; because distribution must be as same as original
|
|
447 ;; article.
|
|
448 "Distribution: " (or distribution "") "\n"
|
2843
|
449 mail-header-separator "\n"
|
267
|
450 )
|
|
451 ;; Send the control article to NNTP server.
|
|
452 (message "Canceling your article...")
|
2843
|
453 (if (gnus-inews-article)
|
267
|
454 (message "Canceling your article... done")
|
|
455 (ding) (message "Failed to cancel your article"))
|
2843
|
456 ;; Kill the article buffer.
|
267
|
457 (kill-buffer (current-buffer))
|
|
458 )))
|
|
459 ))
|
|
460
|
|
461
|
|
462 ;;; Lowlevel inews interface
|
|
463
|
|
464 (defun gnus-inews-article ()
|
2843
|
465 "Post an article in current buffer using NNTP protocol."
|
|
466 (let ((artbuf (current-buffer))
|
267
|
467 (tmpbuf (get-buffer-create " *GNUS-posting*")))
|
|
468 (save-excursion
|
|
469 (set-buffer tmpbuf)
|
12166
|
470 (buffer-disable-undo (current-buffer))
|
267
|
471 (erase-buffer)
|
|
472 (insert-buffer-substring artbuf)
|
2843
|
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.
|
267
|
485 (save-restriction
|
|
486 (goto-char (point-min))
|
|
487 (search-forward "\n\n")
|
|
488 (narrow-to-region (point-min) (point))
|
2843
|
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)
|
267
|
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
|
2843
|
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
|
|
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))
|
12166
|
580 (insert "-- \n")
|
2843
|
581 (insert-file-contents signature)))
|
|
582 ))))))
|
|
583
|
267
|
584 (defun gnus-inews-do-fcc ()
|
2843
|
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."
|
267
|
592 (let ((fcc-list nil)
|
|
593 (fcc-file nil)
|
|
594 (case-fold-search t)) ;Should ignore case.
|
|
595 (save-excursion
|
|
596 (save-restriction
|
|
597 (goto-char (point-min))
|
2843
|
598 (search-forward "\n\n")
|
|
599 (narrow-to-region (point-min) (point))
|
|
600 (goto-char (point-min))
|
267
|
601 (while (re-search-forward "^FCC:[ \t]*" nil t)
|
2843
|
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))
|
267
|
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.
|
5111
|
628 (if (and gnus-author-copy-saver
|
|
629 (not (eq gnus-author-copy-saver 'rmail-output)))
|
5110
|
630 (funcall gnus-author-copy-saver fcc-file)
|
13119
|
631 (if (and (file-readable-p fcc-file)
|
|
632 (mail-file-babyl-p fcc-file))
|
5110
|
633 (gnus-output-to-rmail fcc-file)
|
|
634 (rmail-output fcc-file 1 t t)))
|
267
|
635 ))
|
|
636 )
|
|
637 ))
|
|
638 ))
|
|
639
|
|
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 ()
|
8070
|
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)
|
267
|
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.
|
5910
287191542bb3
(gnus-inews-login-name): Remove unnecessary (getenv "LOGNAME") and (getenv
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
669 Got from the variable `gnus-user-login-name' and the function
|
287191542bb3
(gnus-inews-login-name): Remove unnecessary (getenv "LOGNAME") and (getenv
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
670 `user-login-name'."
|
287191542bb3
(gnus-inews-login-name): Remove unnecessary (getenv "LOGNAME") and (getenv
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
671 (or gnus-user-login-name (user-login-name)))
|
267
|
672
|
|
673 (defun gnus-inews-full-name ()
|
|
674 "Return user full name.
|
8070
|
675 Got from the variable `gnus-user-full-name', the environment variable
|
|
676 NAME, and the function `user-full-name'."
|
267
|
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."
|
8112
|
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)))))
|
267
|
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
|
3495
|
734 (defun gnus-current-time-zone (time)
|
|
735 "The local time zone in effect at TIME, or nil if not known."
|
4172
|
736 (let ((z (and (fboundp 'current-time-zone) (current-time-zone time))))
|
3495
|
737 (if (and z (car z)) z gnus-local-timezone)))
|
|
738
|
267
|
739 (defun gnus-inews-date ()
|
2843
|
740 "Date string of today.
|
3495
|
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))))
|
2843
|
750
|
3495
|
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)."
|
2843
|
756 (timezone-make-date-arpa-standard
|
3495
|
757 (if (fboundp 'current-time)
|
|
758 (current-time-string time)
|
|
759 (current-time-string))
|
|
760 zone "GMT"))
|
2843
|
761
|
3495
|
762 (defun gnus-inews-buggy-date (&optional time)
|
3506
|
763 "A buggy date string that represents TIME.
|
3495
|
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))))
|
267
|
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.
|
2843
|
784 If not, the variable gnus-local-organization is used instead.
|
267
|
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
|
2843
|
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)))
|
267
|
800 (and (stringp organization)
|
4172
|
801 (> (length organization) 0)
|
267
|
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 )))
|
2843
|
827 ((string-equal organization private-file) nil) ;No such file
|
267
|
828 (t organization))
|
|
829 ))
|
584
|
830
|
2843
|
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
|
584
|
840 (provide 'gnuspost)
|
660
|
841
|
|
842 ;;; gnuspost.el ends here
|