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